Session CZH_Elementary_Categories

Theory CZH_ECAT_Introduction

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉIntroductionβ€Ί
theory CZH_ECAT_Introduction
  imports CZH_Foundations.CZH_DG_Introduction
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
This article provides a 
formalization of the elementary theory of 1-categories without
an additional structure. For further information see 
chapter Introduction in the first installment of 
this work: β€ΉCategory Theory for ZFC in HOL I: Foundationsβ€Ί.
β€Ί



subsectionβ€ΉPreliminariesβ€Ί

named_theorems cat_op_simps
named_theorems cat_op_intros

named_theorems cat_cs_simps
named_theorems cat_cs_intros

named_theorems cat_arrow_cs_intros



subsectionβ€ΉCS setup for foundationsβ€Ί

lemmas (in 𝒡) [cat_cs_intros] = 
  𝒡_Ξ²
  
textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Category

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉCategoryβ€Ί
theory CZH_ECAT_Category
  imports 
    CZH_ECAT_Introduction
    CZH_Foundations.CZH_SMC_Semicategory
begin



subsectionβ€ΉBackgroundβ€Ί

lemmas [cat_cs_simps] = dg_shared_cs_simps
lemmas [cat_cs_intros] = dg_shared_cs_intros

definition CId :: V
  where [dg_field_simps]: "CId = 5β„•"



subsubsectionβ€ΉSlicingβ€Ί

definition cat_smc :: "V β‡’ V"
  where "cat_smc β„­ = [ℭ⦇Obj⦈, ℭ⦇Arr⦈, ℭ⦇Dom⦈, ℭ⦇Cod⦈, ℭ⦇Comp⦈]∘"


textβ€ΉComponents.β€Ί

lemma cat_smc_components[slicing_simps]:
  shows "cat_smc ℭ⦇Obj⦈ = ℭ⦇Obj⦈"
    and "cat_smc ℭ⦇Arr⦈ = ℭ⦇Arr⦈"
    and "cat_smc ℭ⦇Dom⦈ = ℭ⦇Dom⦈"
    and "cat_smc ℭ⦇Cod⦈ = ℭ⦇Cod⦈"
    and "cat_smc ℭ⦇Comp⦈ = ℭ⦇Comp⦈"
  unfolding cat_smc_def dg_field_simps by (auto simp: nat_omega_simps)


textβ€ΉRegular definitions.β€Ί

lemma cat_smc_is_arr[slicing_simps]: 
  "f : a ↦cat_smc β„­ b ⟷ f : a ↦ℭ b"
  unfolding is_arr_def slicing_simps ..

lemmas [slicing_intros] = cat_smc_is_arr[THEN iffD2]

lemma cat_smc_composable_arrs[slicing_simps]:
  "composable_arrs (cat_smc β„­) = composable_arrs β„­"
  unfolding composable_arrs_def slicing_simps ..

lemma cat_smc_is_monic_arr[slicing_simps]: 
  "f : a ↦moncat_smc β„­ b ⟷ f : a ↦monβ„­ b"
  unfolding is_monic_arr_def slicing_simps ..

lemmas [slicing_intros] = cat_smc_is_monic_arr[THEN iffD2]

lemma cat_smc_is_epic_arr[slicing_simps]: 
  "f : a ↦epicat_smc β„­ b ⟷ f : a ↦epiβ„­ b"
  unfolding is_epic_arr_def slicing_simps op_smc_def 
  by (simp add: nat_omega_simps)

lemmas [slicing_intros] = cat_smc_is_epic_arr[THEN iffD2]

lemma cat_smc_is_idem_arr[slicing_simps]:
  "f : ↦idecat_smc β„­ b ⟷ f : ↦ideβ„­ b"
  unfolding is_idem_arr_def slicing_simps ..

lemmas [slicing_intros] = cat_smc_is_idem_arr[THEN iffD2]

lemma cat_smc_obj_terminal[slicing_simps]:
  "obj_terminal (cat_smc β„­) a ⟷ obj_terminal β„­ a"
  unfolding obj_terminal_def slicing_simps ..

lemmas [slicing_intros] = cat_smc_obj_terminal[THEN iffD2]

lemma cat_smc_obj_intial[slicing_simps]:
  "obj_initial (cat_smc β„­) a ⟷ obj_initial β„­ a"
  unfolding obj_initial_def obj_terminal_def 
  unfolding smc_op_simps slicing_simps
  ..

lemmas [slicing_intros] = cat_smc_obj_intial[THEN iffD2]

lemma cat_smc_obj_null[slicing_simps]: 
  "obj_null (cat_smc β„­) a ⟷ obj_null β„­ a"
  unfolding obj_null_def slicing_simps smc_op_simps ..

lemmas [slicing_intros] = cat_smc_obj_null[THEN iffD2]

lemma cat_smc_is_zero_arr[slicing_simps]:
  "f : a ↦0cat_smc β„­ b ⟷ f : a ↦0β„­ b"
  unfolding is_zero_arr_def slicing_simps ..

lemmas [slicing_intros] = cat_smc_is_zero_arr[THEN iffD2]



subsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The definition of a category that is used in this work is
is similar to the definition that can be found in Chapter I-2 in 
\cite{mac_lane_categories_2010}. The amendments to the definitions that are 
associated with size have already been explained in the previous 
installment of this body of work.
β€Ί

locale category = 𝒡 Ξ± + vfsequence β„­ + CId: vsv ‹ℭ⦇CIdβ¦ˆβ€Ί for Ξ± β„­ +
  assumes cat_length[cat_cs_simps]: "vcard β„­ = 6β„•"
    and cat_semicategory[slicing_intros]: "semicategory Ξ± (cat_smc β„­)"
    and cat_CId_vdomain[cat_cs_simps]: "π’Ÿβˆ˜ (ℭ⦇CId⦈) = ℭ⦇Obj⦈"
    and cat_CId_is_arr[cat_cs_intros]: "a ∈∘ ℭ⦇Obj⦈ ⟹ ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"
    and cat_CId_left_left[cat_cs_simps]: 
      "f : a ↦ℭ b ⟹ ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = f"
    and cat_CId_right_left[cat_cs_simps]: 
      "f : b ↦ℭ c ⟹ f ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"

lemmas [cat_cs_simps] = 
  category.cat_length
  category.cat_CId_vdomain
  category.cat_CId_left_left
  category.cat_CId_right_left

lemma (in category) cat_CId_is_arr'[cat_cs_intros]:
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b = a" and "c = a" and "β„­' = β„­"
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : b ↦ℭ' c"
  using assms(1) unfolding assms(2-4) by (rule cat_CId_is_arr)

lemmas [cat_cs_intros] = category.cat_CId_is_arr'

lemma (in category) cat_CId_is_arr''[cat_cs_intros]:
  assumes "a ∈∘ ℭ⦇Obj⦈" and "f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
  shows "f : a ↦ℭ a"
  using assms(1) unfolding assms(2) by (cs_concl cs_intro: cat_cs_intros)

lemmas [cat_cs_intros] = category.cat_CId_is_arr''

lemmas [slicing_intros] = category.cat_semicategory

lemma (in category) cat_CId_vrange: "β„›βˆ˜ (ℭ⦇CId⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof
  fix f assume "f ∈∘ β„›βˆ˜ (ℭ⦇CId⦈)"
  with cat_CId_vdomain obtain a where "a ∈∘ ℭ⦇Obj⦈" and "f = ℭ⦇CIdβ¦ˆβ¦‡a⦈" 
    by (auto elim!: CId.vrange_atE)
  with cat_CId_is_arr show "f ∈∘ ℭ⦇Arr⦈" by auto
qed


textβ€ΉRules.β€Ί

lemma (in category) category_axioms'[cat_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "category Ξ±' β„­"
  unfolding assms by (rule category_axioms)

mk_ide rf category_def[unfolded category_axioms_def]
  |intro categoryI|
  |dest categoryD[dest]|
  |elim categoryE[elim]|

lemma categoryI':
  assumes "𝒡 Ξ±"
    and "vfsequence β„­"
    and "vcard β„­ = 6β„•"
    and "vsv (ℭ⦇Dom⦈)"
    and "vsv (ℭ⦇Cod⦈)"
    and "vsv (ℭ⦇Comp⦈)"
    and "vsv (ℭ⦇CId⦈)"
    and "π’Ÿβˆ˜ (ℭ⦇Dom⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Dom⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "π’Ÿβˆ˜ (ℭ⦇Cod⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Cod⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "β‹€gf. gf ∈∘ π’Ÿβˆ˜ (ℭ⦇Comp⦈) ⟷
      (βˆƒg f b c a. gf = [g, f]∘ ∧ g : b ↦ℭ c ∧ f : a ↦ℭ b)"
    and "π’Ÿβˆ˜ (ℭ⦇CId⦈) = ℭ⦇Obj⦈"
    and "β‹€b c g a f. ⟦ g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹ g ∘Aβ„­ f : a ↦ℭ c"
    and "β‹€c d h b g a f. ⟦ h : c ↦ℭ d; g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹
      (h ∘Aβ„­ g) ∘Aβ„­ f = h ∘Aβ„­ (g ∘Aβ„­ f)"
    and "β‹€a. a ∈∘ ℭ⦇Obj⦈ ⟹ ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"
    and "β‹€a b f. f : a ↦ℭ b ⟹ ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = f"
    and "β‹€b c f. f : b ↦ℭ c ⟹ f ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"
    and "ℭ⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    and "β‹€A B. ⟦ A βŠ†βˆ˜ ℭ⦇Obj⦈; B βŠ†βˆ˜ ℭ⦇Obj⦈; A ∈∘ Vset Ξ±; B ∈∘ Vset Ξ± ⟧ ⟹
      (β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom β„­ a b) ∈∘ Vset Ξ±"
  shows "category Ξ± β„­"
  by (intro categoryI semicategoryI', unfold cat_smc_components slicing_simps)
    (simp_all add: assms smc_dg_def nat_omega_simps cat_smc_def)

lemma categoryD':
  assumes "category Ξ± β„­" 
  shows "𝒡 Ξ±"
    and "vfsequence β„­"
    and "vcard β„­ = 6β„•"
    and "vsv (ℭ⦇Dom⦈)"
    and "vsv (ℭ⦇Cod⦈)"
    and "vsv (ℭ⦇Comp⦈)"
    and "vsv (ℭ⦇CId⦈)"
    and "π’Ÿβˆ˜ (ℭ⦇Dom⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Dom⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "π’Ÿβˆ˜ (ℭ⦇Cod⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Cod⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "β‹€gf. gf ∈∘ π’Ÿβˆ˜ (ℭ⦇Comp⦈) ⟷
      (βˆƒg f b c a. gf = [g, f]∘ ∧ g : b ↦ℭ c ∧ f : a ↦ℭ b)"
    and "π’Ÿβˆ˜ (ℭ⦇CId⦈) = ℭ⦇Obj⦈"
    and "β‹€b c g a f. ⟦ g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹ g ∘Aβ„­ f : a ↦ℭ c"
    and "β‹€c d h b g a f. ⟦ h : c ↦ℭ d; g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹
      (h ∘Aβ„­ g) ∘Aβ„­ f = h ∘Aβ„­ (g ∘Aβ„­ f)"
    and "β‹€a. a ∈∘ ℭ⦇Obj⦈ ⟹ ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"
    and "β‹€a b f. f : a ↦ℭ b ⟹ ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = f"
    and "β‹€b c f. f : b ↦ℭ c ⟹ f ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"
    and "ℭ⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    and "β‹€A B. ⟦ A βŠ†βˆ˜ ℭ⦇Obj⦈; B βŠ†βˆ˜ ℭ⦇Obj⦈; A ∈∘ Vset Ξ±; B ∈∘ Vset Ξ± ⟧ ⟹
      (β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom β„­ a b) ∈∘ Vset Ξ±"
  by 
    (
      simp_all add: 
        categoryD(2-9)[OF assms] 
        semicategoryD'[OF categoryD(5)[OF assms], unfolded slicing_simps]
    )

lemma categoryE':
  assumes "category Ξ± β„­" 
  obtains "𝒡 Ξ±"
    and "vfsequence β„­"
    and "vcard β„­ = 6β„•"
    and "vsv (ℭ⦇Dom⦈)"
    and "vsv (ℭ⦇Cod⦈)"
    and "vsv (ℭ⦇Comp⦈)"
    and "vsv (ℭ⦇CId⦈)"
    and "π’Ÿβˆ˜ (ℭ⦇Dom⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Dom⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "π’Ÿβˆ˜ (ℭ⦇Cod⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Cod⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "β‹€gf. gf ∈∘ π’Ÿβˆ˜ (ℭ⦇Comp⦈) ⟷
      (βˆƒg f b c a. gf = [g, f]∘ ∧ g : b ↦ℭ c ∧ f : a ↦ℭ b)"
    and "π’Ÿβˆ˜ (ℭ⦇CId⦈) = ℭ⦇Obj⦈"
    and "β‹€b c g a f. ⟦ g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹ g ∘Aβ„­ f : a ↦ℭ c"
    and "β‹€c d h b g a f. ⟦ h : c ↦ℭ d; g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹
      (h ∘Aβ„­ g) ∘Aβ„­ f = h ∘Aβ„­ (g ∘Aβ„­ f)"
    and "β‹€a. a ∈∘ ℭ⦇Obj⦈ ⟹ ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"
    and "β‹€a b f. f : a ↦ℭ b ⟹ ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = f"
    and "β‹€b c f. f : b ↦ℭ c ⟹ f ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"
    and "ℭ⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    and "β‹€A B. ⟦ A βŠ†βˆ˜ ℭ⦇Obj⦈; B βŠ†βˆ˜ ℭ⦇Obj⦈; A ∈∘ Vset Ξ±; B ∈∘ Vset Ξ± ⟧ ⟹
      (β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom β„­ a b) ∈∘ Vset Ξ±"
  using assms by (simp add: categoryD')


textβ€ΉSlicing.β€Ί

context category
begin

interpretation smc: semicategory Ξ± β€Ήcat_smc β„­β€Ί by (rule cat_semicategory)

sublocale Dom: vsv ‹ℭ⦇Domβ¦ˆβ€Ί 
  by (rule smc.Dom.vsv_axioms[unfolded slicing_simps])
sublocale Cod: vsv ‹ℭ⦇Codβ¦ˆβ€Ί 
  by (rule smc.Cod.vsv_axioms[unfolded slicing_simps])
sublocale Comp: pbinop ‹ℭ⦇Arrβ¦ˆβ€Ί ‹ℭ⦇Compβ¦ˆβ€Ί
  by (rule smc.Comp.pbinop_axioms[unfolded slicing_simps])

lemmas_with [unfolded slicing_simps]:
  cat_Dom_vdomain[cat_cs_simps] = smc.smc_Dom_vdomain
  and cat_Dom_vrange = smc.smc_Dom_vrange
  and cat_Cod_vdomain[cat_cs_simps] = smc.smc_Cod_vdomain
  and cat_Cod_vrange = smc.smc_Cod_vrange
  and cat_Obj_vsubset_Vset = smc.smc_Obj_vsubset_Vset
  and cat_Hom_vifunion_in_Vset[cat_cs_intros] = smc.smc_Hom_vifunion_in_Vset
  and cat_Obj_if_Dom_vrange = smc.smc_Obj_if_Dom_vrange
  and cat_Obj_if_Cod_vrange = smc.smc_Obj_if_Cod_vrange
  and cat_is_arrD = smc.smc_is_arrD
  and cat_is_arrE[elim] = smc.smc_is_arrE
  and cat_in_ArrE[elim] = smc.smc_in_ArrE
  and cat_Hom_in_Vset[cat_cs_intros] = smc.smc_Hom_in_Vset
  and cat_Arr_vsubset_Vset = smc.smc_Arr_vsubset_Vset
  and cat_Dom_vsubset_Vset = smc.smc_Dom_vsubset_Vset
  and cat_Cod_vsubset_Vset = smc.smc_Cod_vsubset_Vset
  and cat_Obj_in_Vset = smc.smc_Obj_in_Vset
  and cat_in_Obj_in_Vset[cat_cs_intros] = smc.smc_in_Obj_in_Vset
  and cat_Arr_in_Vset = smc.smc_Arr_in_Vset
  and cat_in_Arr_in_Vset[cat_cs_intros] = smc.smc_in_Arr_in_Vset
  and cat_Dom_in_Vset = smc.smc_Dom_in_Vset
  and cat_Cod_in_Vset = smc.smc_Cod_in_Vset
  and cat_semicategory_if_ge_Limit = smc.smc_semicategory_if_ge_Limit
  and cat_Dom_app_in_Obj = smc.smc_Dom_app_in_Obj
  and cat_Cod_app_in_Obj = smc.smc_Cod_app_in_Obj
  and cat_Arr_vempty_if_Obj_vempty = smc.smc_Arr_vempty_if_Obj_vempty
  and cat_Dom_vempty_if_Arr_vempty = smc.smc_Dom_vempty_if_Arr_vempty
  and cat_Cod_vempty_if_Arr_vempty = smc.smc_Cod_vempty_if_Arr_vempty

lemmas [cat_cs_intros] = cat_is_arrD(2,3)

lemmas_with [unfolded slicing_simps slicing_commute]:
  cat_Comp_vdomain = smc.smc_Comp_vdomain
  and cat_Comp_is_arr[cat_cs_intros] = smc.smc_Comp_is_arr
  and cat_Comp_assoc[cat_cs_intros] = smc.smc_Comp_assoc
  and cat_Comp_vdomainI[cat_cs_intros] = smc.smc_Comp_vdomainI
  and cat_Comp_vdomainE[elim!] = smc.smc_Comp_vdomainE
  and cat_Comp_vdomain_is_composable_arrs = 
    smc.smc_Comp_vdomain_is_composable_arrs
  and cat_Comp_vrange = smc.smc_Comp_vrange
  and cat_Comp_vsubset_Vset = smc.smc_Comp_vsubset_Vset
  and cat_Comp_in_Vset = smc.smc_Comp_in_Vset
  and cat_Comp_vempty_if_Arr_vempty = smc.smc_Comp_vempty_if_Arr_vempty
  and cat_assoc_helper = smc.smc_assoc_helper
  and cat_pattern_rectangle_right = smc.smc_pattern_rectangle_right
  and cat_pattern_rectangle_left = smc.smc_pattern_rectangle_left
  and is_epic_arrI = smc.is_epic_arrI
  and is_epic_arrD[dest] = smc.is_epic_arrD
  and is_epic_arrE[elim!] = smc.is_epic_arrE
  and cat_comp_is_monic_arr[cat_arrow_cs_intros] = smc.smc_Comp_is_monic_arr
  and cat_comp_is_epic_arr[cat_arrow_cs_intros] = smc.smc_Comp_is_epic_arr
  and cat_comp_is_monic_arr_is_monic_arr =
    smc.smc_Comp_is_monic_arr_is_monic_arr
  and cat_is_zero_arr_comp_right[cat_arrow_cs_intros] = 
    smc.smc_is_zero_arr_Comp_right
  and cat_is_zero_arr_comp_left[cat_arrow_cs_intros] = 
    smc.smc_is_zero_arr_Comp_left

lemma cat_Comp_is_arr'[cat_cs_intros]:
  assumes "g : b ↦ℭ c"
    and "f : a ↦ℭ b"
    and "β„­' = β„­"
  shows "g ∘Aβ„­ f : a ↦ℭ' c"
  using assms(1,2) unfolding assms(3) by (rule cat_Comp_is_arr)

end

lemmas [cat_cs_simps] = is_idem_arrD(2)

lemmas [cat_cs_simps] = category.cat_Comp_assoc

lemmas [cat_cs_intros] =
  category.cat_Comp_vdomainI
  category.cat_is_arrD(1-3)
  category.cat_Comp_is_arr'
  category.cat_Comp_is_arr

lemmas [cat_arrow_cs_intros] = 
  is_monic_arrD(1) 
  is_epic_arr_is_arr
  category.cat_comp_is_monic_arr
  category.cat_comp_is_epic_arr
  category.cat_is_zero_arr_comp_right
  category.cat_is_zero_arr_comp_left

lemmas [cat_cs_intros] = HomI
lemmas [cat_cs_simps] = in_Hom_iff


textβ€ΉElementary properties.β€Ί

lemma cat_eqI:
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅"
    and "𝔄⦇Obj⦈ = 𝔅⦇Obj⦈"
    and "𝔄⦇Arr⦈ = 𝔅⦇Arr⦈"
    and "𝔄⦇Dom⦈ = 𝔅⦇Dom⦈"
    and "𝔄⦇Cod⦈ = 𝔅⦇Cod⦈"
    and "𝔄⦇Comp⦈ = 𝔅⦇Comp⦈"
    and "𝔄⦇CId⦈ = 𝔅⦇CId⦈"
  shows "𝔄 = 𝔅"
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  show ?thesis
  proof(rule vsv_eqI)
    have dom: "π’Ÿβˆ˜ 𝔄 = 6β„•" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
    show "π’Ÿβˆ˜ 𝔄 = π’Ÿβˆ˜ 𝔅" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
    show "a ∈∘ π’Ÿβˆ˜ 𝔄 ⟹ 𝔄⦇a⦈ = 𝔅⦇a⦈" for a 
      by (unfold dom, elim_in_numeral, insert assms) (auto simp: dg_field_simps)
  qed auto
qed

lemma cat_smc_eqI:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔄⦇CId⦈ = 𝔅⦇CId⦈"
    and "cat_smc 𝔄 = cat_smc 𝔅"
  shows "𝔄 = 𝔅"
proof(rule cat_eqI[of Ξ±])
  from assms(4) have 
    "cat_smc 𝔄⦇Obj⦈ = cat_smc 𝔅⦇Obj⦈"
    "cat_smc 𝔄⦇Arr⦈ = cat_smc 𝔅⦇Arr⦈"
    "cat_smc 𝔄⦇Dom⦈ = cat_smc 𝔅⦇Dom⦈"
    "cat_smc 𝔄⦇Cod⦈ = cat_smc 𝔅⦇Cod⦈" 
    "cat_smc 𝔄⦇Comp⦈ = cat_smc 𝔅⦇Comp⦈" 
    by auto
  then show
    "𝔄⦇Obj⦈ = 𝔅⦇Obj⦈"
    "𝔄⦇Arr⦈ = 𝔅⦇Arr⦈"
    "𝔄⦇Dom⦈ = 𝔅⦇Dom⦈"
    "𝔄⦇Cod⦈ = 𝔅⦇Cod⦈"
    "𝔄⦇Comp⦈ = 𝔅⦇Comp⦈" 
    unfolding slicing_simps by simp_all
qed (auto simp: assms)

lemma (in category) cat_def: 
  "β„­ = [ℭ⦇Obj⦈, ℭ⦇Arr⦈, ℭ⦇Dom⦈, ℭ⦇Cod⦈, ℭ⦇Comp⦈, ℭ⦇CId⦈]∘"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ β„­ = 6β„•" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
  have dom_rhs: "π’Ÿβˆ˜ [ℭ⦇Obj⦈, ℭ⦇Arr⦈, ℭ⦇Dom⦈, ℭ⦇Cod⦈, ℭ⦇Comp⦈, ℭ⦇CId⦈]∘ = 6β„•"
    by (simp add: nat_omega_simps)
  then show "π’Ÿβˆ˜ β„­ = π’Ÿβˆ˜ [ℭ⦇Obj⦈, ℭ⦇Arr⦈, ℭ⦇Dom⦈, ℭ⦇Cod⦈, ℭ⦇Comp⦈, ℭ⦇CId⦈]∘"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ β„­ ⟹
    ℭ⦇a⦈ = [ℭ⦇Obj⦈, ℭ⦇Arr⦈, ℭ⦇Dom⦈, ℭ⦇Cod⦈, ℭ⦇Comp⦈, ℭ⦇CId⦈]βˆ˜β¦‡a⦈" 
    for a
    unfolding dom_lhs
    by elim_in_numeral (simp_all add: dg_field_simps nat_omega_simps)
qed auto


textβ€ΉSize.β€Ί

lemma (in category) cat_CId_vsubset_Vset: "ℭ⦇CId⦈ βŠ†βˆ˜ Vset Ξ±"
proof(intro vsubsetI)
  fix af assume "af ∈∘ ℭ⦇CId⦈"
  then obtain a f 
    where af_def: "af = ⟨a, f⟩" 
      and a: "a ∈∘ π’Ÿβˆ˜ (ℭ⦇CId⦈)" 
      and f: "f ∈∘ β„›βˆ˜ (ℭ⦇CId⦈)"
    by (auto elim: CId.vbrelation_vinE)
  from a have "a ∈∘ Vset α" by (auto simp: cat_cs_simps intro: cat_cs_intros)
  from f cat_CId_vrange have "f ∈∘ ℭ⦇Arr⦈" by auto
  then have "f ∈∘ Vset α" by (auto simp: cat_cs_simps intro: cat_cs_intros)
  then show "af ∈∘ Vset α" 
    by (simp add: af_def Limit_vpair_in_VsetI β€Ήa ∈∘ Vset Ξ±β€Ί)
qed

lemma (in category) cat_category_in_Vset_4: "β„­ ∈∘ Vset (Ξ± + 4β„•)"
proof-
  note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
    cat_Obj_vsubset_Vset
    cat_Arr_vsubset_Vset
    cat_Dom_vsubset_Vset
    cat_Cod_vsubset_Vset
    cat_Comp_vsubset_Vset
    cat_CId_vsubset_Vset
  show ?thesis
    by (subst cat_def, succ_of_numeral)
      (
        cs_concl 
          cs_simp: plus_V_succ_right V_cs_simps 
          cs_intro: cat_cs_intros V_cs_intros
      )
qed

lemma (in category) cat_CId_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "ℭ⦇CId⦈ ∈∘ Vset Ξ²"
proof-
  interpret 𝒡 Ξ² by (rule assms(1))
  from assms have "π’Ÿβˆ˜ (ℭ⦇CId⦈) ∈∘ Vset Ξ²" 
    by (auto simp: cat_cs_simps cat_Obj_in_Vset)
  moreover from assms cat_CId_vrange have "β„›βˆ˜ (ℭ⦇CId⦈) ∈∘ Vset Ξ²"  
    by (auto intro: cat_Arr_in_Vset)
  ultimately show ?thesis by (blast intro: 𝒡_Limit_Ξ±Ο‰)
qed

lemma (in category) cat_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "β„­ ∈∘ Vset Ξ²"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show ?thesis
  proof(rule vsv.vsv_Limit_vsv_in_VsetI)
    have dom: "π’Ÿβˆ˜ β„­ = 6β„•" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
    from assms show "π’Ÿβˆ˜ β„­ ∈∘ Vset Ξ²"
      unfolding dom by (simp add: 𝒡.ord_of_nat_in_Vset)
    have "n ∈∘ π’Ÿβˆ˜ β„­ ⟹ ℭ⦇n⦈ ∈∘ Vset Ξ²" for n
      unfolding dom
      by 
        (
          elim_in_numeral, 
          allβ€Ήrewrite in "βŒ‘ ∈∘ _" dg_field_simps[symmetric]β€Ί,
          insert assms
        )
        (
          auto simp:
            cat_Obj_in_Vset
            cat_Arr_in_Vset
            cat_Dom_in_Vset
            cat_Cod_in_Vset
            cat_Comp_in_Vset
            cat_CId_in_Vset
        )
    then show "β„›βˆ˜ β„­ βŠ†βˆ˜ Vset Ξ²" by (metis vsubsetI vrange_atD)
    show "vfinite (π’Ÿβˆ˜ β„­)" unfolding dom by auto
  qed (simp_all add: 𝒡_Limit_Ξ±Ο‰ vsv_axioms)
qed

lemma (in category) cat_category_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "category Ξ² β„­"
  by (rule categoryI)
    (
      auto 
        intro: cat_cs_intros 
        simp: cat_cs_simps assms vfsequence_axioms cat_semicategory_if_ge_Limit 
    )

lemma tiny_category[simp]: "small {β„­. category Ξ± β„­}"
proof(cases ‹𝒡 Ξ±β€Ί)
  case True
  from category.cat_in_Vset[of Ξ±] show ?thesis
    by (intro down[of _ β€ΉVset (Ξ± + Ο‰)β€Ί])
      (auto simp: True 𝒡.𝒡_Limit_Ξ±Ο‰ 𝒡.𝒡_Ο‰_Ξ±Ο‰ 𝒡.intro 𝒡.𝒡_Ξ±_Ξ±Ο‰)
next
  case False
  then have "{β„­. category Ξ± β„­} = {}" by auto
  then show ?thesis by simp
qed

lemma (in 𝒡) categories_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "set {β„­. category Ξ± β„­} ∈∘ Vset Ξ²"
proof(rule vsubset_in_VsetI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "set {β„­. category Ξ± β„­} βŠ†βˆ˜ Vset (Ξ± + 4β„•)"
  proof(intro vsubsetI)
    fix β„­ assume prems: "β„­ ∈∘ set {β„­. category Ξ± β„­}"
    interpret category Ξ± β„­ using prems by simp
    show "β„­ ∈∘ Vset (Ξ± + 4β„•)"
      unfolding VPow_iff by (rule cat_category_in_Vset_4)
  qed
  from assms(2) show "Vset (Ξ± + 4β„•) ∈∘ Vset Ξ²"
    by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed

lemma category_if_category:
  assumes "category Ξ² β„­"
    and "𝒡 Ξ±"
    and "ℭ⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    and "β‹€A B. ⟦ A βŠ†βˆ˜ ℭ⦇Obj⦈; B βŠ†βˆ˜ ℭ⦇Obj⦈; A ∈∘ Vset Ξ±; B ∈∘ Vset Ξ± ⟧ ⟹
      (β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom β„­ a b) ∈∘ Vset Ξ±"
  shows "category Ξ± β„­"
proof-
  interpret category Ξ² β„­ by (rule assms(1))
  interpret Ξ±: 𝒡 Ξ± by (rule assms(2))
  show ?thesis
  proof(intro categoryI)
    show "vfsequence β„­" by (simp add: vfsequence_axioms)
    show "semicategory Ξ± (cat_smc β„­)"
      by (rule semicategory_if_semicategory, unfold slicing_simps)
        (auto intro!: assms(1,3,4) slicing_intros)
  qed (auto intro: cat_cs_intros simp: cat_cs_simps)
qed


textβ€ΉFurther elementary properties.β€Ί

sublocale category βŠ† CId: v11 ‹ℭ⦇CIdβ¦ˆβ€Ί
proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
  fix a b assume prems:
    "a ∈∘ ℭ⦇Obj⦈" "b ∈∘ ℭ⦇Obj⦈" "ℭ⦇CIdβ¦ˆβ¦‡a⦈ = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  have "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : b ↦ℭ b" "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"  
    by (subst prems(3))
      (cs_concl cs_simp: cat_cs_simps cs_intro: prems(1,2) cat_cs_intros)+
  with prems show "a = b" by auto (*slow*)
qed auto

lemma (in category) cat_CId_vempty_if_Arr_vempty:
  assumes "ℭ⦇Arr⦈ = 0"
  shows "ℭ⦇CId⦈ = 0"
  using assms cat_CId_vrange by (auto intro: CId.vsv_vrange_vempty)



subsectionβ€ΉOpposite categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-2 in \cite{mac_lane_categories_2010}.β€Ί

definition op_cat :: "V β‡’ V"
  where "op_cat β„­ = [ℭ⦇Obj⦈, ℭ⦇Arr⦈, ℭ⦇Cod⦈, ℭ⦇Dom⦈, fflip (ℭ⦇Comp⦈), ℭ⦇CId⦈]∘"


textβ€ΉComponents.β€Ί

lemma op_cat_components:
  shows [cat_op_simps]: "op_cat ℭ⦇Obj⦈ = ℭ⦇Obj⦈"
    and [cat_op_simps]: "op_cat ℭ⦇Arr⦈ = ℭ⦇Arr⦈"
    and [cat_op_simps]: "op_cat ℭ⦇Dom⦈ = ℭ⦇Cod⦈"
    and [cat_op_simps]: "op_cat ℭ⦇Cod⦈ = ℭ⦇Dom⦈"
    and "op_cat ℭ⦇Comp⦈ = fflip (ℭ⦇Comp⦈)"
    and [cat_op_simps]: "op_cat ℭ⦇CId⦈ = ℭ⦇CId⦈"
  unfolding op_cat_def dg_field_simps by (auto simp: nat_omega_simps)

lemma op_cat_component_intros[cat_op_intros]:
  shows "a ∈∘ ℭ⦇Obj⦈ ⟹ a ∈∘ op_cat ℭ⦇Obj⦈"
    and "f ∈∘ ℭ⦇Arr⦈ ⟹ f ∈∘ op_cat ℭ⦇Arr⦈"
  unfolding cat_op_simps by simp_all


textβ€ΉSlicing.β€Ί

lemma cat_smc_op_cat[slicing_commute]: "op_smc (cat_smc β„­) = cat_smc (op_cat β„­)"
  unfolding cat_smc_def op_cat_def op_smc_def dg_field_simps
  by (simp add: nat_omega_simps)

lemma (in category) op_smc_op_cat[cat_op_simps]: "op_smc (op_cat β„­) = cat_smc β„­"
  using Comp.pbinop_fflip_fflip
  unfolding op_smc_def op_cat_def cat_smc_def dg_field_simps
  by (simp add: nat_omega_simps)

lemma op_cat_is_arr[cat_op_simps]: "f : b ↦op_cat β„­ a ⟷ f : a ↦ℭ b"
  unfolding cat_op_simps is_arr_def by auto

lemmas [cat_op_intros] = op_cat_is_arr[THEN iffD2]

lemma op_cat_Hom[cat_op_simps]: "Hom (op_cat β„­) a b = Hom β„­ b a"
  unfolding cat_op_simps by simp

lemma op_cat_obj_initial[cat_op_simps]: 
  "obj_initial (op_cat β„­) a ⟷ obj_terminal β„­ a"
  unfolding obj_initial_def obj_terminal_def 
  unfolding smc_op_simps cat_op_simps 
  ..

lemmas [cat_op_intros] = op_cat_obj_initial[THEN iffD2]

lemma op_cat_obj_terminal[cat_op_simps]: 
  "obj_terminal (op_cat β„­) a ⟷ obj_initial β„­ a"
  unfolding obj_initial_def obj_terminal_def 
  unfolding smc_op_simps cat_op_simps 
  ..

lemmas [cat_op_intros] = op_cat_obj_terminal[THEN iffD2]

lemma op_cat_obj_null[cat_op_simps]: "obj_null (op_cat β„­) a ⟷ obj_null β„­ a"
  unfolding obj_null_def cat_op_simps by auto

lemmas [cat_op_intros] = op_cat_obj_null[THEN iffD2]

context category
begin

interpretation smc: semicategory Ξ± β€Ήcat_smc β„­β€Ί by (rule cat_semicategory)

lemmas_with [unfolded slicing_simps slicing_commute]:
  op_cat_Comp_vrange[cat_op_simps] = smc.op_smc_Comp_vrange
  and op_cat_Comp[cat_op_simps] = smc.op_smc_Comp
  and op_cat_is_epic_arr[cat_op_simps] = smc.op_smc_is_epic_arr
  and op_cat_is_monic_arr[cat_op_simps] = smc.op_smc_is_monic_arr
  and op_cat_is_zero_arr[cat_op_simps] = smc.op_smc_is_zero_arr

end

lemmas [cat_op_simps] = 
  category.op_cat_Comp_vrange
  category.op_cat_Comp
  category.op_cat_is_epic_arr
  category.op_cat_is_monic_arr
  category.op_cat_is_zero_arr

context
  fixes β„­ :: V
begin

lemmas_with [
  where β„­=β€Ήcat_smc β„­β€Ί, unfolded slicing_simps slicing_commute[symmetric]
  ]:   
  op_cat_Comp_vdomain[cat_op_simps] = op_smc_Comp_vdomain

end


textβ€ΉElementary properties.β€Ί

lemma op_cat_vsv[cat_op_intros]: "vsv (op_cat β„­)" unfolding op_cat_def by auto


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in category) category_op[cat_cs_intros]: "category Ξ± (op_cat β„­)"
proof(intro categoryI, unfold cat_op_simps)
  show "vfsequence (op_cat β„­)" unfolding op_cat_def by simp
  show "vcard (op_cat β„­) = 6β„•" 
    unfolding op_cat_def by (simp add: nat_omega_simps)
next
  fix f a b assume "f : b ↦ℭ a"
  with category_axioms show "ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aop_cat β„­ f = f"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
next
  fix f b c assume "f : c ↦ℭ b" 
  with category_axioms show "f ∘Aop_cat β„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed 
  (
    auto simp:
      cat_cs_simps 
      cat_op_simps 
      slicing_commute[symmetric] 
      smc_op_intros 
      cat_cs_intros
      cat_semicategory 
  )

lemmas category_op[cat_op_intros] = category.category_op

lemma (in category) cat_op_cat_op_cat[cat_op_simps]: "op_cat (op_cat β„­) = β„­"
proof(rule cat_eqI, unfold cat_op_simps op_cat_components)
  show "category Ξ± (op_cat (op_cat β„­))" 
    by (simp add: category.category_op category_op)
  show "fflip (fflip (ℭ⦇Comp⦈)) = ℭ⦇Comp⦈" by (rule Comp.pbinop_fflip_fflip)
qed (auto simp: cat_cs_intros)

lemmas cat_op_cat_op_cat[cat_op_simps] = category.cat_op_cat_op_cat

lemma eq_op_cat_iff[cat_op_simps]: 
  assumes "category Ξ± 𝔄" and "category Ξ± 𝔅"
  shows "op_cat 𝔄 = op_cat 𝔅 ⟷ 𝔄 = 𝔅"
proof
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  assume prems: "op_cat 𝔄 = op_cat 𝔅"
  show "𝔄 = 𝔅"
  proof(rule cat_eqI)
    show 
      "𝔄⦇Obj⦈ = 𝔅⦇Obj⦈" 
      "𝔄⦇Arr⦈ = 𝔅⦇Arr⦈" 
      "𝔄⦇Dom⦈ = 𝔅⦇Dom⦈"
      "𝔄⦇Cod⦈ = 𝔅⦇Cod⦈"
      "𝔄⦇Comp⦈ = 𝔅⦇Comp⦈"
      "𝔄⦇CId⦈ = 𝔅⦇CId⦈"
      by (metis 𝔄.cat_op_cat_op_cat 𝔅.cat_op_cat_op_cat prems)+
  qed (auto intro: cat_cs_intros)
qed auto



subsectionβ€ΉMonic arrow and epic arrowβ€Ί

lemma (in category) cat_CId_is_monic_arr[cat_arrow_cs_intros]: 
  assumes "a ∈∘ ℭ⦇Obj⦈" 
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦monβ„­ a"
  using assms cat_CId_is_arr' cat_CId_left_left by (force intro!: is_monic_arrI)

lemmas [cat_arrow_cs_intros] = category.cat_CId_is_monic_arr

lemma (in category) cat_CId_is_epic_arr[cat_arrow_cs_intros]: 
  assumes "a ∈∘ ℭ⦇Obj⦈" 
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦epiβ„­ a"
proof-
  from assms have "a ∈∘ op_cat ℭ⦇Obj⦈" unfolding cat_op_simps .
  from category.cat_CId_is_monic_arr[OF category_op this, unfolded cat_op_simps]
  show ?thesis.
qed

lemmas [cat_arrow_cs_intros] = category.cat_CId_is_epic_arr



subsectionβ€ΉRight inverse and left inverse of an arrowβ€Ί


textβ€ΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί

definition is_right_inverse :: "V β‡’ V β‡’ V β‡’ bool"
  where "is_right_inverse β„­ g f = 
    (βˆƒa b. g : b ↦ℭ a ∧ f : a ↦ℭ b ∧ f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈)"

definition is_left_inverse :: "V β‡’ V β‡’ V β‡’ bool"
  where "is_left_inverse β„­ ≑ is_right_inverse (op_cat β„­)"


textβ€ΉRules.β€Ί

lemma is_right_inverseI:
  assumes "g : b ↦ℭ a" and "f : a ↦ℭ b" and "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  shows "is_right_inverse β„­ g f"
  using assms unfolding is_right_inverse_def by auto

lemma is_right_inverseD[dest]:
  assumes "is_right_inverse β„­ g f"
  shows "βˆƒa b. g : b ↦ℭ a ∧ f : a ↦ℭ b ∧ f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  using assms unfolding is_right_inverse_def by clarsimp

lemma is_right_inverseE[elim]:
  assumes "is_right_inverse β„­ g f"
  obtains a b where "g : b ↦ℭ a" 
    and "f : a ↦ℭ b" 
    and "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  using assms by auto

lemma (in category) is_left_inverseI:
  assumes "g : b ↦ℭ a" and "f : a ↦ℭ b" and "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
  shows "is_left_inverse β„­ g f"
proof-
  from assms(3) have "f ∘Aop_cat β„­ g = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    unfolding op_cat_Comp[OF assms(1,2)].
  from 
    is_right_inverseI[of β€Ήop_cat β„­β€Ί, unfolded cat_op_simps, OF assms(1,2) this]
  show ?thesis
    unfolding is_left_inverse_def .
qed

lemma (in category) is_left_inverseD[dest]:
  assumes "is_left_inverse β„­ g f"
  shows "βˆƒa b. g : b ↦ℭ a ∧ f : a ↦ℭ b ∧ g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
proof-
  from is_right_inverseD[OF assms[unfolded is_left_inverse_def]] obtain a b
    where "g : b ↦op_cat β„­ a" 
      and "f : a ↦op_cat β„­ b" 
      and fg: "f ∘Aop_cat β„­ g = op_cat ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    by clarsimp
  then have g: "g : a ↦ℭ b" and f: "f : b ↦ℭ a"
    unfolding cat_op_simps by simp_all
  moreover from fg have "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    unfolding op_cat_Comp[OF g f] cat_op_simps by simp
  ultimately show ?thesis by blast  
qed

lemma (in category) is_left_inverseE[elim]:
  assumes "is_left_inverse β„­ g f"
  obtains a b where "g : b ↦ℭ a" 
    and "f : a ↦ℭ b" 
    and "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
  using assms by auto


textβ€ΉElementary properties.β€Ί

lemma (in category) op_cat_is_left_inverse[cat_op_simps]:
  "is_left_inverse (op_cat β„­) g f ⟷ is_right_inverse β„­ g f"
  unfolding is_left_inverse_def is_right_inverse_def cat_op_simps by simp

lemmas [cat_op_simps] = category.op_cat_is_left_inverse

lemmas [cat_op_intros] = category.op_cat_is_left_inverse[THEN iffD2]

lemma (in category) op_cat_is_right_inverse[cat_op_simps]:
  "is_right_inverse (op_cat β„­) g f ⟷ is_left_inverse β„­ g f"
  unfolding is_left_inverse_def is_right_inverse_def cat_op_simps by simp

lemmas [cat_op_simps] = category.op_cat_is_right_inverse

lemmas [cat_op_intros] = category.op_cat_is_right_inverse[THEN iffD2]



subsectionβ€ΉInverse of an arrowβ€Ί


textβ€ΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί

definition is_inverse :: "V β‡’ V β‡’ V β‡’ bool"
  where "is_inverse β„­ g f =
    (
      βˆƒa b.
        g : b ↦ℭ a ∧
        f : a ↦ℭ b ∧
        g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈ ∧
        f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈
    )"


textβ€ΉRules.β€Ί

lemma is_inverseI:
  assumes "g : b ↦ℭ a"
    and "f : a ↦ℭ b"
    and "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    and "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  shows "is_inverse β„­ g f"
  using assms unfolding is_inverse_def by auto

lemma is_inverseD[dest]: 
  assumes "is_inverse β„­ g f"
  shows 
    "(
      βˆƒa b.
        g : b ↦ℭ a ∧
        f : a ↦ℭ b ∧
        g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈ ∧
        f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈
    )"
  using assms unfolding is_inverse_def by auto

lemma is_inverseE[elim]:
  assumes "is_inverse β„­ g f"
  obtains a b where "g : b ↦ℭ a"
    and "f : a ↦ℭ b"
    and "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    and "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  using assms by auto


textβ€ΉElementary properties.β€Ί

lemma (in category) op_cat_is_inverse[cat_op_simps]: 
  "is_inverse (op_cat β„­) g f ⟷ is_inverse β„­ g f"
  by (rule iffI; unfold is_inverse_def cat_op_simps) (metis op_cat_Comp)+

lemmas [cat_op_simps] = category.op_cat_is_inverse

lemmas [cat_op_intros] = category.op_cat_is_inverse[THEN iffD2]

lemma is_inverse_sym: "is_inverse β„­ g f ⟷ is_inverse β„­ f g"
  unfolding is_inverse_def by auto

lemma (in category) cat_is_inverse_eq:
  ―‹See Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "is_inverse β„­ h f" and "is_inverse β„­ g f"
  shows "h = g"
  using assms
proof(elim is_inverseE)
  fix a b a' b'
  assume prems: 
    "h : b ↦ℭ a" 
    "f : a ↦ℭ b" 
    "h ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    "f ∘Aβ„­ h = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    "g : b' ↦ℭ a'" 
    "f : a' ↦ℭ b'" 
    "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a'⦈" 
  then have ab: "a' = a" "b' = b" by auto 
  from prems have gf: "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈" and g: "g : b ↦ℭ a" 
    unfolding ab by simp_all
  from prems(1) have "h = (g ∘Aβ„­ f) ∘Aβ„­ h" 
    unfolding gf by (simp add: cat_cs_simps)
  also with category_axioms prems(1,2) g have "… = g"
    by (cs_concl cs_simp: prems(4) cat_cs_simps cs_intro: cat_cs_intros)
  finally show "h = g" by simp
qed

lemma is_inverse_Comp_CId_left:
  ―‹See Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "is_inverse β„­ g' g" and "g : a ↦ℭ b"
  shows "g' ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
  using assms by auto

lemma is_inverse_Comp_CId_right:
  assumes "is_inverse β„­ g' g" and "g : a ↦ℭ b"
  shows "g ∘Aβ„­ g' = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  by (metis assms is_arrD(3) is_inverseE)

lemma (in category) cat_is_inverse_Comp:
  ―‹See Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes gbc[intro]: "g : b ↦ℭ c"
    and fab[intro]: "f : a ↦ℭ b"
    and g'g[intro]: "is_inverse β„­ g' g"
    and f'f[intro]: "is_inverse β„­ f' f"
  shows "is_inverse β„­ (f' ∘Aβ„­ g') (g ∘Aβ„­ f)"
proof-
  from g'g gbc f'f fab have g'cb: "g' : c ↦ℭ b" and f'ba: "f' : b ↦ℭ a"
    by (metis is_arrD(2,3) is_inverseD)+
  with assms have f'g': "f' ∘Aβ„­ g' : c ↦ℭ a" and gf: "g ∘Aβ„­ f : a ↦ℭ c" 
    by (auto intro: cat_Comp_is_arr)
  have ff': "is_inverse β„­ f f'" using assms by (simp add: is_inverse_sym)
  note [simp] = 
    cat_Comp_assoc[symmetric, OF f'g' gbc fab] 
    cat_Comp_assoc[OF f'ba g'cb gbc]
    is_inverse_Comp_CId_left[OF g'g gbc]
    cat_Comp_assoc[symmetric, OF gf f'ba g'cb]
    cat_Comp_assoc[OF gbc fab f'ba]
    is_inverse_Comp_CId_left[OF ff' f'ba]
    cat_CId_right_left[OF f'ba]
    cat_CId_right_left[OF gbc]
  show ?thesis 
    by (intro is_inverseI, rule f'g', rule gf) 
      (auto intro: is_inverse_Comp_CId_left is_inverse_Comp_CId_right)
qed

lemma (in category) cat_is_inverse_Comp':
  assumes "g : b ↦ℭ c"
    and "f : a ↦ℭ b"
    and "is_inverse β„­ g' g"
    and "is_inverse β„­ f' f"
    and "f'g' = f' ∘Aβ„­ g'"
    and "gf = g ∘Aβ„­ f"
  shows "is_inverse β„­ f'g' gf"
  using assms(1-4) unfolding assms(5,6) by (intro cat_is_inverse_Comp)

lemmas [cat_cs_intros] = category.cat_is_inverse_Comp'

lemma is_inverse_is_right_inverse[dest]:
  assumes "is_inverse β„­ g f" 
  shows "is_right_inverse β„­ g f"
  using assms by (auto intro: is_right_inverseI)

lemma (in category) cat_is_inverse_is_left_inverse[dest]:
  assumes "is_inverse β„­ g f" 
  shows "is_left_inverse β„­ g f"
proof-
  interpret op: category Ξ± β€Ήop_cat β„­β€Ί by (auto intro!: cat_cs_intros)
  from assms have "is_inverse (op_cat β„­) g f" by (simp add: cat_op_simps)
  from is_inverse_is_right_inverse[OF this] show ?thesis
    unfolding is_left_inverse_def .
qed

lemma (in category) cat_is_right_left_inverse_is_inverse:
  assumes "is_right_inverse β„­ g f" "is_left_inverse β„­ g f"
  shows "is_inverse β„­ g f"
  using assms
proof(elim is_right_inverseE is_left_inverseE)
  fix a b c d assume prems:
    "g : b ↦ℭ a"
    "f : a ↦ℭ b"
    "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    "g : d ↦ℭ c"
    "f : c ↦ℭ d"
    "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡c⦈"
  then have dbca: "d = b" "c = a" by auto
  note [cat_cs_simps] = prems(3,6)[unfolded dbca]
  from prems(1,2) show "is_inverse β„­ g f"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros is_inverseI)
qed



subsectionβ€ΉIsomorphismβ€Ί


textβ€ΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί

definition is_arr_isomorphism :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  where "is_arr_isomorphism β„­ a b f ⟷
    (f : a ↦ℭ b ∧ (βˆƒg. is_inverse β„­ g f))"

syntax "_is_arr_isomorphism" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή_ : _ ↦isoΔ± _β€Ί [51, 51, 51] 51)
translations "f : a ↦isoβ„­ b" β‡Œ "CONST is_arr_isomorphism β„­ a b f"


textβ€ΉRules.β€Ί

lemma is_arr_isomorphismI:
  assumes "f : a ↦ℭ b" and "is_inverse β„­ g f"
  shows "f : a ↦isoβ„­ b"
  using assms unfolding is_arr_isomorphism_def by auto

lemma is_arr_isomorphismD[dest]:
  assumes "f : a ↦isoβ„­ b"
  shows "f : a ↦ℭ b" and "βˆƒg. is_inverse β„­ g f"
  using assms unfolding is_arr_isomorphism_def by auto

lemma is_arr_isomorphismE[elim]:
  assumes "f : a ↦isoβ„­ b"
  obtains g where "f : a ↦ℭ b" and "is_inverse β„­ g f"
  using assms by force

lemma is_arr_isomorphismE':
  assumes "f : a ↦isoβ„­ b"
  obtains g where "g : b ↦isoβ„­ a"
    and "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    and "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
proof-
  from assms obtain g where f: "f : a ↦ℭ b" "is_inverse β„­ g f" by auto
  then have "g : b ↦ℭ a"
    and "f : a ↦ℭ b"
    and gf: "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    and fg: "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    by auto
  then have g: "g : b ↦isoβ„­ a" 
    by (cs_concl cs_intro: is_inverseI is_arr_isomorphismI)
  from that f g gf fg show ?thesis by simp
qed


textβ€ΉElementary properties.β€Ί

lemma (in category) op_cat_is_arr_isomorphism[cat_op_simps]:
  "f : b ↦isoop_cat β„­ a ⟷ f : a ↦isoβ„­ b"
  unfolding is_arr_isomorphism_def cat_op_simps by simp

lemmas [cat_op_simps] = category.op_cat_is_arr_isomorphism

lemmas [cat_op_intros] = category.op_cat_is_arr_isomorphism[THEN iffD2]

lemma (in category) is_arr_isomorphismI':
  assumes "f : a ↦ℭ b" 
    and "g : b ↦ℭ a"
    and "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    and "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
  shows "f : a ↦isoβ„­ b" and "g : b ↦isoβ„­ a"
proof-
  from assms have gf: "is_inverse β„­ g f" by (auto intro: is_inverseI)
  from assms have fg: "is_inverse β„­ f g" by (auto intro: is_inverseI)
  show "f : a ↦isoβ„­ b" and "g : b ↦isoβ„­ a"
    by 
      (
        intro 
          is_arr_isomorphismI[OF assms(1) gf]
          is_arr_isomorphismI[OF assms(2) fg]
      )+
qed

lemma (in category) cat_is_inverse_is_arr_isomorphism:
  assumes "f : a ↦ℭ b" and "is_inverse β„­ g f"
  shows "g : b ↦isoβ„­ a"
proof(intro is_arr_isomorphismI is_inverseI) 
  from assms(2) obtain a' b' 
    where g: "g : b' ↦ℭ a'"
      and f: "f : a' ↦ℭ b'"
      and gf: "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a'⦈"
      and fg: "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b'⦈"
    by auto
  with assms(1) have a'b': "a' = a" "b' = b" by auto
  from g f gf fg show 
    "g : b ↦ℭ a"
    "f : a ↦ℭ b"
    "g : b ↦ℭ a"
    "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    unfolding a'b' by auto
qed

lemma (in category) cat_Comp_is_arr_isomorphism[cat_arrow_cs_intros]:
  assumes "g : b ↦isoβ„­ c" and "f : a ↦isoβ„­ b"
  shows "g ∘Aβ„­ f : a ↦isoβ„­ c"
proof-
  from assms have [intro]: "g ∘Aβ„­ f : a ↦ℭ c" 
    by (auto intro: cat_cs_intros)
  from assms(1) obtain g' where g'g: "is_inverse β„­ g' g" by force
  with assms(1) have [intro]: "g' : c ↦ℭ b" 
    by (elim is_arr_isomorphismE)
      (auto simp: is_arr_isomorphismD cat_is_inverse_is_arr_isomorphism)
  from assms(2) obtain f' where f'f: "is_inverse β„­ f' f" by auto
  with assms(2) have [intro]: "f' : b ↦ℭ a"
    by (elim is_arr_isomorphismE)
      (auto simp: is_arr_isomorphismD cat_is_inverse_is_arr_isomorphism)
  have "f' ∘Aβ„­ g' : c ↦ℭ a" by (auto intro: cat_cs_intros)
  from cat_is_inverse_Comp[OF _ _ g'g f'f] assms 
  have "is_inverse β„­ (f' ∘Aβ„­ g') (g ∘Aβ„­ f)" 
    by (elim is_arr_isomorphismE) simp
  then show ?thesis by (auto intro: is_arr_isomorphismI)
qed

lemmas [cat_arrow_cs_intros] = category.cat_Comp_is_arr_isomorphism

lemma (in category) cat_CId_is_arr_isomorphism: 
  assumes "a ∈∘ ℭ⦇Obj⦈" 
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦isoβ„­ a"
  using assms 
  by 
    (
      cs_concl 
        cs_intro: cat_cs_intros is_inverseI cat_is_inverse_is_arr_isomorphism 
        cs_simp: cat_cs_simps
    )

lemma (in category) cat_CId_is_arr_isomorphism'[cat_arrow_cs_intros]:
  assumes "a ∈∘ ℭ⦇Obj⦈"
    and "β„­' = β„­"
    and "b = a"
    and "c = a"
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : b ↦isoβ„­' c"
  using assms(1) 
  unfolding assms(2-4)
  by (rule cat_CId_is_arr_isomorphism)

lemmas [cat_arrow_cs_intros] = category.cat_CId_is_arr_isomorphism'

lemma (in category) cat_is_arr_isomorphism_is_monic_arr[cat_arrow_cs_intros]:
  assumes "f : a ↦isoβ„­ b"
  shows "f : a ↦monβ„­ b"
proof(intro is_monic_arrI)
  note [cat_cs_intros] = is_arr_isomorphismD(1)
  show "f : a ↦ℭ b" by (intro is_arr_isomorphismD(1)[OF assms])
  fix h g c assume prems: 
    "h : c ↦ℭ a" "g : c ↦ℭ a" "f ∘Aβ„­ h = f ∘Aβ„­ g"
  from assms obtain f' 
    where f': "f' : b ↦isoβ„­ a" 
      and [cat_cs_simps]: "f' ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈" 
    by (auto elim: is_arr_isomorphismE')
  from category_axioms assms prems(1,2) have "h = (f' ∘Aβ„­ f) ∘Aβ„­ h"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  also from category_axioms assms prems(1,2) f' have "… = (f' ∘Aβ„­ f) ∘Aβ„­ g"
    by (cs_concl cs_simp: prems(3) cat_cs_simps cs_intro: cat_cs_intros)
  also from category_axioms assms prems(1,2) f' have "… = g"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  finally show "h = g" by simp
qed

lemmas [cat_arrow_cs_intros] = category.cat_is_arr_isomorphism_is_monic_arr

lemma (in category) cat_is_arr_isomorphism_is_epic_arr:
  assumes "f : a ↦isoβ„­ b"
  shows "f : a ↦epiβ„­ b"
  using assms
  by 
    (
      rule 
        category.cat_is_arr_isomorphism_is_monic_arr[
          OF category_op, unfolded cat_op_simps
          ]
    )

lemmas [cat_arrow_cs_intros] = category.cat_is_arr_isomorphism_is_epic_arr



subsectionβ€ΉThe inverse arrowβ€Ί


textβ€ΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί

definition the_inverse :: "V β‡’ V β‡’ V" (β€Ή(_Β―CΔ±)β€Ί [1000] 999)
  where "fΒ―Cβ„­ = (THE g. is_inverse β„­ g f)"


textβ€ΉElementary properties.β€Ί

lemma (in category) cat_is_inverse_is_inverse_the_inverse:
  assumes "is_inverse β„­ g f"
  shows "is_inverse β„­ (fΒ―Cβ„­) f"
  unfolding the_inverse_def
proof(rule theI)
  fix g' assume "is_inverse β„­ g' f"
  then show "g' = g" by (meson cat_is_inverse_eq assms)
qed (rule assms)

lemma (in category) cat_is_inverse_eq_the_inverse:
  assumes "is_inverse β„­ g f"
  shows "g = fΒ―Cβ„­"
  by (meson assms cat_is_inverse_is_inverse_the_inverse cat_is_inverse_eq)


textβ€ΉThe inverse arrow is an inverse of an isomorphism.β€Ί

lemma (in category) cat_the_inverse_is_inverse:
  assumes "f : a ↦isoβ„­ b"
  shows "is_inverse β„­ (fΒ―Cβ„­) f"
proof-
  from assms obtain g where "is_inverse β„­ g f" by auto
  then show "is_inverse β„­ (fΒ―Cβ„­) f"
    by (rule cat_is_inverse_is_inverse_the_inverse)
qed

lemma (in category) cat_the_inverse_is_arr_isomorphism:
  assumes "f : a ↦isoβ„­ b"
  shows "fΒ―Cβ„­ : b ↦isoβ„­ a"
proof-
  from assms have f: "f : a ↦ℭ b" by auto
  have "is_inverse β„­ (fΒ―Cβ„­) f" by (rule cat_the_inverse_is_inverse[OF assms])
  from cat_is_inverse_is_arr_isomorphism[OF f this] show ?thesis .
qed

lemma (in category) cat_the_inverse_is_arr_isomorphism':
  assumes "f : a ↦isoβ„­ b" and "β„­' = β„­"
  shows "fΒ―Cβ„­ : b ↦isoβ„­' a"
  using assms(1) 
  unfolding assms(2)
  by (rule cat_the_inverse_is_arr_isomorphism)

lemmas [cat_cs_intros] = category.cat_the_inverse_is_arr_isomorphism'

lemma (in category) op_cat_the_inverse:
  assumes "f : a ↦isoβ„­ b"
  shows "fΒ―Cop_cat β„­ = fΒ―Cβ„­"
proof-
  from assms have "f : b ↦isoop_cat β„­ a" unfolding cat_op_simps by simp
  from assms show ?thesis
    by 
      (
        intro 
          category.cat_is_inverse_eq_the_inverse[
            symmetric, OF category_op, unfolded cat_op_simps
            ] 
          cat_the_inverse_is_inverse
      )
qed

lemmas [cat_op_simps] = category.op_cat_the_inverse

lemma (in category) cat_Comp_the_inverse:
  assumes "g : b ↦isoβ„­ c" and "f : a ↦isoβ„­ b"
  shows "(g ∘Aβ„­ f)Β―Cβ„­ = fΒ―Cβ„­ ∘Aβ„­ gΒ―Cβ„­"
proof-
  from assms have "g ∘Aβ„­ f : a ↦isoβ„­ c" 
    by (cs_concl cs_intro: cat_arrow_cs_intros)
  then have inv_gf: "is_inverse β„­ ((g ∘Aβ„­ f)Β―Cβ„­) (g ∘Aβ„­ f)"
    by (intro cat_the_inverse_is_inverse)
  from assms have "is_inverse β„­ (gΒ―Cβ„­) g" "is_inverse β„­ (fΒ―Cβ„­) f"
    by (auto intro: cat_the_inverse_is_inverse)
  with category_axioms assms have 
    "is_inverse β„­ (fΒ―Cβ„­ ∘Aβ„­ gΒ―Cβ„­) (g ∘Aβ„­ f)"
    by (cs_concl cs_intro: cat_cs_intros cat_arrow_cs_intros) 
  from inv_gf this show "(g ∘Aβ„­ f)Β―Cβ„­ = fΒ―Cβ„­ ∘Aβ„­ gΒ―Cβ„­"
    by (meson cat_is_inverse_eq)
qed

lemmas [cat_cs_simps] = category.cat_Comp_the_inverse

lemma (in category) cat_the_inverse_Comp_CId:
  assumes "f : a ↦isoβ„­ b"
  shows cat_the_inverse_Comp_CId_left: "fΒ―Cβ„­ ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    and cat_the_inverse_Comp_CId_right: "f ∘Aβ„­ fΒ―Cβ„­ = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
proof-
  from assms show "fΒ―Cβ„­ ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    by 
      (
        cs_concl
          cs_simp: is_inverse_Comp_CId_left
          cs_intro: cat_the_inverse_is_inverse cat_arrow_cs_intros
      )
  from assms show "f ∘Aβ„­ fΒ―Cβ„­ = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    by 
      (
        cs_concl
          cs_simp: is_inverse_Comp_CId_right
          cs_intro: cat_the_inverse_is_inverse cat_arrow_cs_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_the_inverse_Comp_CId

lemma (in category) cat_the_inverse_the_inverse:
  assumes "f : a ↦isoβ„­ b"
  shows "(fΒ―Cβ„­)Β―Cβ„­ = f"
proof-
  from assms have 
    "(fΒ―Cβ„­)Β―Cβ„­ = (fΒ―Cβ„­)Β―Cβ„­ ∘Aβ„­ fΒ―Cβ„­ ∘Aβ„­ f"
    by (*slow*)
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros 
      )
  also from assms have "… = f"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
      )
  finally show ?thesis .
qed

lemmas [cat_cs_simps] = category.cat_the_inverse_the_inverse



subsectionβ€ΉIsomorphic objectsβ€Ί


textβ€ΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί

definition obj_iso :: "V β‡’ V β‡’ V β‡’ bool" 
  where "obj_iso β„­ a b ⟷ (βˆƒf. f : a ↦isoβ„­ b)"

syntax "_obj_iso" :: "V β‡’ V β‡’ V β‡’ bool" (β€Ή(_/ β‰ˆobjΔ± _)β€Ί [55, 56] 55)
translations "a β‰ˆobjβ„­ b" β‡Œ "CONST obj_iso β„­ a b"


textβ€ΉRules.β€Ί

lemma obj_isoI:
  assumes "f : a ↦isoβ„­ b" 
  shows "a β‰ˆobjβ„­ b"
  using assms unfolding obj_iso_def by auto

lemma obj_isoD[dest]:
  assumes "a β‰ˆobjβ„­ b" 
  shows "βˆƒf. f : a ↦isoβ„­ b" 
  using assms unfolding obj_iso_def by auto
  
lemma obj_isoE[elim!]:
  assumes "a β‰ˆobjβ„­ b" 
  obtains f where "f : a ↦isoβ„­ b"
  using assms by auto


textβ€ΉElementary properties.β€Ί

lemma (in category) op_cat_obj_iso[cat_op_simps]: 
  "a β‰ˆobjop_cat β„­ b = b β‰ˆobjβ„­ a"
  unfolding obj_iso_def cat_op_simps ..

lemmas [cat_op_simps] = category.op_cat_obj_iso

lemmas [cat_op_intros] = category.op_cat_obj_iso[THEN iffD2]


textβ€ΉEquivalence relation.β€Ί

lemma (in category) cat_obj_iso_refl:
  assumes "a ∈∘ ℭ⦇Obj⦈" 
  shows "a β‰ˆobjβ„­ a"
  using assms by (auto intro: obj_isoI cat_arrow_cs_intros)

lemma (in category) cat_obj_iso_sym[sym]: 
  assumes "a β‰ˆobjβ„­ b" 
  shows "b β‰ˆobjβ„­ a"
  using assms 
  by (elim obj_isoE is_arr_isomorphismE) 
    (metis obj_iso_def cat_is_inverse_is_arr_isomorphism)

lemma (in category) cat_obj_iso_trans[trans]:
  assumes "a β‰ˆobjβ„­ b" and "b β‰ˆobjβ„­ c" 
  shows "a β‰ˆobjβ„­ c"
  using assms by (auto intro: cat_Comp_is_arr_isomorphism obj_isoI)



subsectionβ€ΉTerminal object and initial objectβ€Ί

lemma (in category) cat_obj_terminal_CId:
  ―‹See Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "obj_terminal β„­ a" and "f : a ↦ℭ a"
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ = f"
  using assms by (elim obj_terminalE) (metis cat_CId_is_arr)

lemma (in category) cat_obj_initial_CId: 
  ―‹See Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "obj_initial β„­ a" and "f : a ↦ℭ a"
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ = f"
  using assms 
  by (rule category.cat_obj_terminal_CId[OF category_op, unfolded cat_op_simps])

lemma (in category) cat_obj_terminal_obj_iso:
  ―‹See Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "obj_terminal β„­ a" and "obj_terminal β„­ a'"
  shows "a β‰ˆobjβ„­ a'"
proof-
  from assms obtain f where f: "f : a ↦ℭ a'" by auto
  from assms obtain f' where f': "f' : a' ↦ℭ a" by auto
  from f f' cat_obj_terminal_CId cat_Comp_is_arr 
  have f'f: "is_inverse β„­ f' f"
    by (intro is_inverseI[OF f' f]) (metis assms(1), metis assms(2))
  with f show ?thesis by (cs_concl cs_intro: obj_isoI is_arr_isomorphismI)
qed

lemma (in category) cat_obj_initial_obj_iso:
  ―‹See Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "obj_initial β„­ a" and "obj_initial β„­ a'"
  shows "a' β‰ˆobjβ„­ a"
proof-
  interpret op: category Ξ± β€Ήop_cat β„­β€Ί by (auto intro: cat_cs_intros)
  from assms show ?thesis
    by (rule op.cat_obj_terminal_obj_iso[unfolded cat_op_simps])  
qed                     



subsectionβ€ΉNull objectβ€Ί

lemma (in category) cat_obj_null_obj_iso:
  ―‹see Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "obj_null β„­ z" and "obj_null β„­ z'"
  shows "z β‰ˆobjβ„­ z'"
  using assms by (simp add: cat_obj_terminal_obj_iso obj_nullD(2))



subsectionβ€ΉGroupoidβ€Ί


textβ€ΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.β€Ί

locale groupoid = category Ξ± β„­ for Ξ± β„­ +
  assumes grpd_is_arr_isomorphism: "f : a ↦ℭ b ⟹ f : a ↦isoβ„­ b"


textβ€ΉRules.β€Ί

mk_ide rf groupoid_def[unfolded groupoid_axioms_def]
  |intro groupoidI|
  |dest groupoidD[dest]|
  |elim groupoidE[elim]|

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Small_Category

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉSmallness for categoriesβ€Ί
theory CZH_ECAT_Small_Category
  imports 
    CZH_Foundations.CZH_SMC_Small_Semicategory
    CZH_ECAT_Category
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
An explanation of the methodology chosen for the exposition of all
matters related to the size of the categories and associated entities
is given in the first installment of this work.
β€Ί

named_theorems cat_small_cs_simps
named_theorems cat_small_cs_intros



subsectionβ€ΉTiny categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale tiny_category = 𝒡 Ξ± + vfsequence β„­ + CId: vsv ‹ℭ⦇CIdβ¦ˆβ€Ί for Ξ± β„­ +
  assumes tiny_cat_length[cat_cs_simps]: "vcard β„­ = 6β„•"
    and tiny_cat_tiny_semicategory[slicing_intros]: 
      "tiny_semicategory Ξ± (cat_smc β„­)"
    and tiny_cat_CId_vdomain[cat_cs_simps]: "π’Ÿβˆ˜ (ℭ⦇CId⦈) = ℭ⦇Obj⦈"
    and tiny_cat_CId_is_arr[cat_cs_intros]: 
      "a ∈∘ ℭ⦇Obj⦈ ⟹ ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"
    and tiny_cat_CId_left_left[cat_cs_simps]:
      "f : a ↦ℭ b ⟹ ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = f"
    and tiny_cat_CId_right_left[cat_cs_simps]:
      "f : b ↦ℭ c ⟹ f ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"

lemmas [slicing_intros] = tiny_category.tiny_cat_tiny_semicategory


textβ€ΉRules.β€Ί

lemma (in tiny_category) tiny_category_axioms'[cat_small_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "tiny_category Ξ±' β„­"
  unfolding assms by (rule tiny_category_axioms)

mk_ide rf tiny_category_def[unfolded tiny_category_axioms_def]
  |intro tiny_categoryI|
  |dest tiny_categoryD[dest]|
  |elim tiny_categoryE[elim]|

lemma tiny_categoryI':
  assumes "category Ξ± β„­" and "ℭ⦇Obj⦈ ∈∘ Vset Ξ±" and "ℭ⦇Arr⦈ ∈∘ Vset Ξ±"
  shows "tiny_category Ξ± β„­"
proof-
  interpret category Ξ± β„­ by (rule assms(1))
  show ?thesis
  proof(intro tiny_categoryI)
    from assms show "tiny_semicategory Ξ± (cat_smc β„­)"
      by (intro tiny_semicategoryI') (auto simp: slicing_simps)
  qed (auto simp: vfsequence_axioms cat_cs_simps cat_cs_intros)
qed

lemma tiny_categoryI'':
  assumes "𝒡 Ξ±"
    and "vfsequence β„­"
    and "vcard β„­ = 6β„•"
    and "vsv (ℭ⦇Dom⦈)"
    and "vsv (ℭ⦇Cod⦈)"
    and "vsv (ℭ⦇Comp⦈)"
    and "vsv (ℭ⦇CId⦈)"
    and "π’Ÿβˆ˜ (ℭ⦇Dom⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Dom⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "π’Ÿβˆ˜ (ℭ⦇Cod⦈) = ℭ⦇Arr⦈"
    and "β„›βˆ˜ (ℭ⦇Cod⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    and "β‹€gf. gf ∈∘ π’Ÿβˆ˜ (ℭ⦇Comp⦈) ⟷
      (βˆƒg f b c a. gf = [g, f]∘ ∧ g : b ↦ℭ c ∧ f : a ↦ℭ b)"
    and "π’Ÿβˆ˜ (ℭ⦇CId⦈) = ℭ⦇Obj⦈"
    and "β‹€b c g a f. ⟦ g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹ g ∘Aβ„­ f : a ↦ℭ c"
    and "β‹€c d h b g a f. ⟦ h : c ↦ℭ d; g : b ↦ℭ c; f : a ↦ℭ b ⟧ ⟹
      (h ∘Aβ„­ g) ∘Aβ„­ f = h ∘Aβ„­ (g ∘Aβ„­ f)"
    and "β‹€a. a ∈∘ ℭ⦇Obj⦈ ⟹ ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"
    and "β‹€a b f. f : a ↦ℭ b ⟹ ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = f"
    and "β‹€b c f. f : b ↦ℭ c ⟹ f ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"
    and "ℭ⦇Obj⦈ ∈∘ Vset Ξ±" 
    and "ℭ⦇Arr⦈ ∈∘ Vset Ξ±"
  shows "tiny_category Ξ± β„­"
  by (intro tiny_categoryI tiny_semicategoryI'', unfold slicing_simps) 
    (simp_all add: cat_smc_def nat_omega_simps assms)


textβ€ΉSlicing.β€Ί

context tiny_category
begin

interpretation smc: tiny_semicategory Ξ± β€Ήcat_smc β„­β€Ί
  by (rule tiny_cat_tiny_semicategory) 

lemmas_with [unfolded slicing_simps]:
  tiny_cat_semicategory = smc.semicategory_axioms
  and tiny_cat_Obj_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Obj_in_Vset
  and tiny_cat_Arr_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Arr_in_Vset
  and tiny_cat_Dom_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Dom_in_Vset
  and tiny_cat_Cod_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Cod_in_Vset
  and tiny_cat_Comp_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Comp_in_Vset

end


textβ€ΉElementary properties.β€Ί

sublocale tiny_category βŠ† category
  by (rule categoryI) 
    (
      auto simp: 
        vfsequence_axioms tiny_cat_semicategory cat_cs_intros cat_cs_simps
    )

lemmas (in tiny_category) tiny_dg_category = category_axioms

lemmas [cat_small_cs_intros] = tiny_category.tiny_dg_category


textβ€ΉSize.β€Ί

lemma (in tiny_category) tiny_cat_CId_in_Vset: "ℭ⦇CId⦈ ∈∘ Vset Ξ±"
proof-
  from tiny_cat_Obj_in_Vset have "π’Ÿβˆ˜ (ℭ⦇CId⦈) ∈∘ Vset Ξ±"
    by (simp add: tiny_cat_Obj_in_Vset cat_cs_simps)
  moreover from tiny_cat_Arr_in_Vset cat_CId_vrange tiny_cat_Arr_in_Vset have 
    "β„›βˆ˜ (ℭ⦇CId⦈) ∈∘ Vset Ξ±"  
    by auto
  ultimately show ?thesis by (blast intro: 𝒡_Limit_Ξ±Ο‰)
qed

lemma (in tiny_category) tiny_cat_in_Vset: "β„­ ∈∘ Vset Ξ±"
proof-
  note [cat_cs_intros] = 
    tiny_cat_Obj_in_Vset 
    tiny_cat_Arr_in_Vset
    tiny_cat_Dom_in_Vset
    tiny_cat_Cod_in_Vset
    tiny_cat_Comp_in_Vset
    tiny_cat_CId_in_Vset
  show ?thesis by (subst cat_def) (cs_concl cs_intro: cat_cs_intros V_cs_intros)
qed

lemma tiny_category[simp]: "small {β„­. tiny_category Ξ± β„­}"
proof(rule down)
  show "{β„­. tiny_category Ξ± β„­} βŠ† elts (set {β„­. category Ξ± β„­})" 
    by (auto intro: cat_small_cs_intros)
qed

lemma small_categories_vsubset_Vset: "set {β„­. tiny_category Ξ± β„­} βŠ†βˆ˜ Vset Ξ±" 
  by (rule vsubsetI) (simp_all add: tiny_category.tiny_cat_in_Vset)

lemma (in category) cat_tiny_category_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_category Ξ² β„­"
proof(intro tiny_categoryI)
  show "tiny_semicategory Ξ² (cat_smc β„­)"
    by 
      (
        rule semicategory.smc_tiny_semicategory_if_ge_Limit, 
        rule cat_semicategory;
        intro assms
      )
qed (auto simp:  assms(1) cat_cs_simps cat_cs_intros vfsequence_axioms)


subsubsectionβ€ΉOpposite tiny categoryβ€Ί

lemma (in tiny_category) tiny_category_op: "tiny_category Ξ± (op_cat β„­)"
  by (intro tiny_categoryI') 
    (auto simp: cat_op_simps cat_cs_intros cat_small_cs_intros)

lemmas tiny_category_op[cat_op_intros] = tiny_category.tiny_category_op



subsectionβ€ΉFinite categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
A definition of a finite category can be found in nLab 
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/finite+category}
}.
β€Ί

(*TODO: implicit redundant assumption*)
locale finite_category = 𝒡 Ξ± + vfsequence β„­ + CId: vsv ‹ℭ⦇CIdβ¦ˆβ€Ί for Ξ± β„­ +
  assumes fin_cat_length[cat_cs_simps]: "vcard β„­ = 6β„•"
    and fin_cat_finite_semicategory[slicing_intros]: 
      "finite_semicategory Ξ± (cat_smc β„­)"
    and fin_cat_CId_vdomain[cat_cs_simps]: "π’Ÿβˆ˜ (ℭ⦇CId⦈) = ℭ⦇Obj⦈"
    and fin_cat_CId_is_arr[cat_cs_intros]: 
      "a ∈∘ ℭ⦇Obj⦈ ⟹ ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦ℭ a"
    and fin_cat_CId_left_left[cat_cs_simps]:
      "f : a ↦ℭ b ⟹ ℭ⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = f"
    and fin_cat_CId_right_left[cat_cs_simps]:
      "f : b ↦ℭ c ⟹ f ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡b⦈ = f"

lemmas [slicing_intros] = finite_category.fin_cat_finite_semicategory


textβ€ΉRules.β€Ί

lemma (in finite_category) fin_category_axioms'[cat_small_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "finite_category Ξ±' β„­"
  unfolding assms by (rule finite_category_axioms)

mk_ide rf finite_category_def[unfolded finite_category_axioms_def]
  |intro finite_categoryI|
  |dest finite_categoryD[dest]|
  |elim finite_categoryE[elim]|

lemma finite_categoryI':
  assumes "category Ξ± β„­"  and "vfinite (ℭ⦇Obj⦈)" and "vfinite (ℭ⦇Arr⦈)"
  shows "finite_category Ξ± β„­"
proof-
  interpret category Ξ± β„­ by (rule assms(1))
  show ?thesis
  proof(intro finite_categoryI)
    from assms show "finite_semicategory Ξ± (cat_smc β„­)"
      by (intro finite_semicategoryI') (auto simp: slicing_simps)
  qed (auto simp: vfsequence_axioms cat_cs_simps cat_cs_intros)
qed

lemma finite_categoryI'': 
  assumes "tiny_category Ξ± β„­" and "vfinite (ℭ⦇Obj⦈)" and "vfinite (ℭ⦇Arr⦈)"
  shows "finite_category Ξ± β„­"
  using assms by (intro finite_categoryI') (auto intro: cat_small_cs_intros)


textβ€ΉSlicing.β€Ί

context finite_category
begin

interpretation smc: finite_semicategory Ξ± β€Ήcat_smc β„­β€Ί
  by (rule fin_cat_finite_semicategory) 

lemmas_with [unfolded slicing_simps]:
  fin_cat_tiny_semicategory = smc.tiny_semicategory_axioms
  and fin_smc_Obj_vfinite[cat_small_cs_intros] = smc.fin_smc_Obj_vfinite
  and fin_smc_Arr_vfinite[cat_small_cs_intros] = smc.fin_smc_Arr_vfinite

end


textβ€ΉElementary properties.β€Ί

sublocale finite_category βŠ† tiny_category
  by (rule tiny_categoryI) 
    (
      auto 
        simp: vfsequence_axioms 
        intro:
          cat_cs_intros cat_cs_simps cat_small_cs_intros
          finite_category.fin_cat_tiny_semicategory
    )

lemmas (in finite_category) fin_cat_tiny_category = tiny_category_axioms

lemmas [cat_small_cs_intros] = finite_category.fin_cat_tiny_category

lemma (in finite_category) fin_cat_in_Vset: "β„­ ∈∘ Vset Ξ±"
  by (rule tiny_cat_in_Vset)


textβ€ΉSize.β€Ί

lemma small_finite_categories[simp]: "small {β„­. finite_category Ξ± β„­}"
proof(rule down)
  show "{β„­. finite_category Ξ± β„­} βŠ† elts (set {β„­. tiny_category  Ξ± β„­})" 
    by (auto intro: cat_small_cs_intros)
qed

lemma small_finite_categories_vsubset_Vset: 
  "set {β„­. finite_category Ξ± β„­} βŠ†βˆ˜ Vset Ξ±" 
  by (rule vsubsetI) (simp_all add: finite_category.fin_cat_in_Vset)


subsubsectionβ€ΉOpposite finite categoryβ€Ί

lemma (in finite_category) finite_category_op: "finite_category Ξ± (op_cat β„­)"
  by (intro finite_categoryI', unfold cat_op_simps) 
    (auto simp: cat_cs_intros cat_small_cs_intros)

lemmas finite_category_op[cat_op_intros] = finite_category.finite_category_op

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Functor

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉFunctorβ€Ί
theory CZH_ECAT_Functor
  imports 
    CZH_ECAT_Category
    CZH_Foundations.CZH_SMC_Semifunctor
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems cf_cs_simps
named_theorems cf_cs_intros

named_theorems cat_cn_cs_simps
named_theorems cat_cn_cs_intros

lemmas [cat_cs_simps] = dg_shared_cs_simps
lemmas [cat_cs_intros] = dg_shared_cs_intros


subsubsectionβ€ΉSlicingβ€Ί

definition cf_smcf :: "V β‡’ V"
  where "cf_smcf β„­ = 
    [ℭ⦇ObjMap⦈, ℭ⦇ArrMap⦈, cat_smc (ℭ⦇HomDom⦈), cat_smc (ℭ⦇HomCod⦈)]∘"


textβ€ΉComponents.β€Ί

lemma cf_smcf_components:
  shows [slicing_simps]: "cf_smcf 𝔉⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    and [slicing_simps]: "cf_smcf 𝔉⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
    and [slicing_commute]: "cf_smcf 𝔉⦇HomDom⦈ = cat_smc (𝔉⦇HomDom⦈)"
    and [slicing_commute]: "cf_smcf 𝔉⦇HomCod⦈ = cat_smc (𝔉⦇HomCod⦈)"
  unfolding cf_smcf_def dghm_field_simps by (auto simp: nat_omega_simps)



subsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.β€Ί

locale is_functor = 
  𝒡 Ξ± + vfsequence 𝔉 + HomDom: category Ξ± 𝔄 + HomCod: category Ξ± 𝔅 
  for Ξ± 𝔄 𝔅 𝔉 +
  assumes cf_length[cat_cs_simps]: "vcard 𝔉 = 4β„•" 
    and cf_is_semifunctor[slicing_intros]: 
      "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMCΞ± cat_smc 𝔅" 
    and cf_HomDom[cat_cs_simps]: "𝔉⦇HomDom⦈ = 𝔄"
    and cf_HomCod[cat_cs_simps]: "𝔉⦇HomCod⦈ = 𝔅"
    and cf_ObjMap_CId[cat_cs_intros]: 
      "c ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈"

syntax "_is_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ↦↦CΞ± 𝔅" β‡Œ "CONST is_functor Ξ± 𝔄 𝔅 𝔉"

abbreviation (input) is_cn_cf :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  where "is_cn_cf Ξ± 𝔄 𝔅 𝔉 ≑ 𝔉 : op_cat 𝔄 ↦↦CΞ± 𝔅"

syntax "_is_cn_cf" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ C↦↦ı _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 C↦↦α 𝔅" ⇀ "CONST is_cn_cf Ξ± 𝔄 𝔅 𝔉"

abbreviation all_cfs :: "V β‡’ V"
  where "all_cfs Ξ± ≑ set {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}"

abbreviation cfs :: "V β‡’ V β‡’ V β‡’ V"
  where "cfs Ξ± 𝔄 𝔅 ≑ set {𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}"

lemmas [cat_cs_simps] =
  is_functor.cf_length
  is_functor.cf_HomDom
  is_functor.cf_HomCod
  is_functor.cf_ObjMap_CId

lemma cn_cf_ObjMap_CId[cat_cn_cs_simps]: 
  assumes "𝔉 : 𝔄 C↦↦α 𝔅" and "c ∈∘ 𝔄⦇Obj⦈"
  shows "𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈"
proof-
  interpret is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(1))
  from assms(2) have c: "c ∈∘ op_cat 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
  show ?thesis by (rule cf_ObjMap_CId[OF c, unfolded cat_op_simps])
qed

lemma (in is_functor) cf_is_semifunctor':
  assumes "𝔄' = cat_smc 𝔄" and "𝔅' = cat_smc 𝔅"
  shows "cf_smcf 𝔉 : 𝔄' ↦↦SMCΞ± 𝔅'"
  unfolding assms by (rule cf_is_semifunctor)

lemmas [slicing_intros] = is_functor.cf_is_semifunctor'

lemma cn_smcf_comp_is_semifunctor: 
  assumes "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "cf_smcf 𝔉 : cat_smc 𝔄 SMC↦↦αcat_smc 𝔅"
  using assms 
  unfolding slicing_simps slicing_commute
  by (rule is_functor.cf_is_semifunctor)

lemma cn_smcf_comp_is_semifunctor'[slicing_intros]: 
  assumes "𝔉 : 𝔄 C↦↦α 𝔅" 
    and "𝔄' = op_smc (cat_smc 𝔄)"
    and "𝔅' = cat_smc 𝔅"
  shows "cf_smcf 𝔉 : 𝔄' ↦↦SMCΞ± 𝔅'"
  using assms(1) unfolding assms(2,3) by (rule cn_smcf_comp_is_semifunctor)


textβ€ΉRules.β€Ί

lemma (in is_functor) is_functor_axioms'[cat_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔉 : 𝔄' ↦↦CΞ±' 𝔅'"
  unfolding assms by (rule is_functor_axioms)

mk_ide rf is_functor_def[unfolded is_functor_axioms_def]
  |intro is_functorI|
  |dest is_functorD[dest]|
  |elim is_functorE[elim]|

lemmas [cat_cs_intros] = is_functorD(3,4)

lemma is_functorI':
  assumes "𝒡 Ξ±"
    and "vfsequence 𝔉"
    and "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "vcard 𝔉 = 4β„•"
    and "𝔉⦇HomDom⦈ = 𝔄"
    and "𝔉⦇HomCod⦈ = 𝔅"
    and "vsv (𝔉⦇ObjMap⦈)"
    and "vsv (𝔉⦇ArrMap⦈)"
    and "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = 𝔄⦇Obj⦈"
    and "β„›βˆ˜ (𝔉⦇ObjMap⦈) βŠ†βˆ˜ 𝔅⦇Obj⦈"
    and "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = 𝔄⦇Arr⦈"
    and "β‹€a b f. f : a ↦𝔄 b ⟹
      𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
    and "β‹€b c g a f. ⟦ g : b ↦𝔄 c; f : a ↦𝔄 b ⟧ ⟹
      𝔉⦇ArrMapβ¦ˆβ¦‡g ∘A𝔄 f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
    and "(β‹€c. c ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈)"
  shows "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  by 
    (
      intro is_functorI is_semifunctorI', 
      unfold cf_smcf_components slicing_simps
    )
    (simp_all add: assms cf_smcf_def nat_omega_simps category.cat_semicategory)

lemma is_functorD':
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝒡 Ξ±"
    and "vfsequence 𝔉"
    and "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "vcard 𝔉 = 4β„•"
    and "𝔉⦇HomDom⦈ = 𝔄"
    and "𝔉⦇HomCod⦈ = 𝔅"
    and "vsv (𝔉⦇ObjMap⦈)"
    and "vsv (𝔉⦇ArrMap⦈)"
    and "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = 𝔄⦇Obj⦈"
    and "β„›βˆ˜ (𝔉⦇ObjMap⦈) βŠ†βˆ˜ 𝔅⦇Obj⦈"
    and "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = 𝔄⦇Arr⦈"
    and "β‹€a b f. f : a ↦𝔄 b ⟹
      𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
    and "β‹€b c g a f. ⟦ g : b ↦𝔄 c; f : a ↦𝔄 b ⟧ ⟹
      𝔉⦇ArrMapβ¦ˆβ¦‡g ∘A𝔄 f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
    and "(β‹€c. c ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈)"
  by 
    (
      simp_all add: 
        is_functorD(2-9)[OF assms] 
        is_semifunctorD'[OF is_functorD(6)[OF assms], unfolded slicing_simps]
    )

lemma is_functorE':
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  obtains "𝒡 Ξ±"
    and "vfsequence 𝔉"
    and "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "vcard 𝔉 = 4β„•"
    and "𝔉⦇HomDom⦈ = 𝔄"
    and "𝔉⦇HomCod⦈ = 𝔅"
    and "vsv (𝔉⦇ObjMap⦈)"
    and "vsv (𝔉⦇ArrMap⦈)"
    and "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = 𝔄⦇Obj⦈"
    and "β„›βˆ˜ (𝔉⦇ObjMap⦈) βŠ†βˆ˜ 𝔅⦇Obj⦈"
    and "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = 𝔄⦇Arr⦈"
    and "β‹€a b f. f : a ↦𝔄 b ⟹
      𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
    and "β‹€b c g a f. ⟦ g : b ↦𝔄 c; f : a ↦𝔄 b ⟧ ⟹
      𝔉⦇ArrMapβ¦ˆβ¦‡g ∘A𝔄 f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
    and "(β‹€c. c ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈)"
  using assms by (simp add: is_functorD')


textβ€ΉA functor is a semifunctor.β€Ί

context is_functor
begin

interpretation smcf: is_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
  by (rule cf_is_semifunctor)

sublocale ObjMap: vsv ‹𝔉⦇ObjMapβ¦ˆβ€Ί
  by (rule smcf.ObjMap.vsv_axioms[unfolded slicing_simps])
sublocale ArrMap: vsv ‹𝔉⦇ArrMapβ¦ˆβ€Ί
  by (rule smcf.ArrMap.vsv_axioms[unfolded slicing_simps])

lemmas_with [unfolded slicing_simps]:
  cf_ObjMap_vsv = smcf.smcf_ObjMap_vsv
  and cf_ArrMap_vsv = smcf.smcf_ArrMap_vsv
  and cf_ObjMap_vdomain[cat_cs_simps] = smcf.smcf_ObjMap_vdomain
  and cf_ObjMap_vrange = smcf.smcf_ObjMap_vrange
  and cf_ArrMap_vdomain[cat_cs_simps] = smcf.smcf_ArrMap_vdomain
  and cf_ArrMap_is_arr = smcf.smcf_ArrMap_is_arr
  and cf_ArrMap_is_arr''[cat_cs_intros] = smcf.smcf_ArrMap_is_arr''
  and cf_ArrMap_is_arr'[cat_cs_intros] = smcf.smcf_ArrMap_is_arr'
  and cf_ObjMap_app_in_HomCod_Obj[cat_cs_intros] = 
    smcf.smcf_ObjMap_app_in_HomCod_Obj
  and cf_ArrMap_vrange = smcf.smcf_ArrMap_vrange
  and cf_ArrMap_app_in_HomCod_Arr[cat_cs_intros] = 
    smcf.smcf_ArrMap_app_in_HomCod_Arr
  and cf_ObjMap_vsubset_Vset = smcf.smcf_ObjMap_vsubset_Vset
  and cf_ArrMap_vsubset_Vset = smcf.smcf_ArrMap_vsubset_Vset
  and cf_ObjMap_in_Vset = smcf.smcf_ObjMap_in_Vset
  and cf_ArrMap_in_Vset = smcf.smcf_ArrMap_in_Vset
  and cf_is_semifunctor_if_ge_Limit = smcf.smcf_is_semifunctor_if_ge_Limit
  and cf_is_arr_HomCod = smcf.smcf_is_arr_HomCod
  and cf_vimage_dghm_ArrMap_vsubset_Hom = 
    smcf.smcf_vimage_dghm_ArrMap_vsubset_Hom

lemmas_with [unfolded slicing_simps]: 
  cf_ArrMap_Comp = smcf.smcf_ArrMap_Comp

end

lemmas [cat_cs_simps] = 
  is_functor.cf_ObjMap_vdomain
  is_functor.cf_ArrMap_vdomain
  is_functor.cf_ArrMap_Comp

lemmas [cat_cs_intros] =
  is_functor.cf_ObjMap_app_in_HomCod_Obj
  is_functor.cf_ArrMap_app_in_HomCod_Arr
  is_functor.cf_ArrMap_is_arr'


textβ€ΉElementary properties.β€Ί

lemma cn_cf_ArrMap_Comp[cat_cn_cs_simps]: 
  assumes "category Ξ± 𝔄" 
    and "𝔉 : 𝔄 C↦↦α 𝔅"
    and "g : c ↦𝔄 b"
    and "f : b ↦𝔄 a" 
  shows "𝔉⦇ArrMapβ¦ˆβ¦‡f ∘A𝔄 g⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔉: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule cn_smcf_ArrMap_Comp
          [
            OF 
              𝔄.cat_semicategory 
              𝔉.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_simps,
            OF assms(3,4)
          ]
      )
qed

lemma cf_eqI:
  assumes "π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Šβ¦‡ObjMap⦈ = 𝔉⦇ObjMap⦈"
    and "π”Šβ¦‡ArrMap⦈ = 𝔉⦇ArrMap⦈"
    and "𝔄 = β„­"
    and "𝔅 = 𝔇"
  shows "π”Š = 𝔉"
proof(rule vsv_eqI)
  interpret L: is_functor Ξ± 𝔄 𝔅 π”Š by (rule assms(1))
  interpret R: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(2))
  from assms(1) show "vsv π”Š" by auto
  from assms(2) show "vsv 𝔉" by auto
  have dom: "π’Ÿβˆ˜ π”Š = 4β„•" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
  show "π’Ÿβˆ˜ π”Š = π’Ÿβˆ˜ 𝔉" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
  from assms(5,6) have sup: "π”Šβ¦‡HomDom⦈ = 𝔉⦇HomDom⦈" "π”Šβ¦‡HomCod⦈ = 𝔉⦇HomCod⦈" 
    by (simp_all add: cat_cs_simps)
  show "a ∈∘ π’Ÿβˆ˜ π”Š ⟹ π”Šβ¦‡a⦈ = 𝔉⦇a⦈" for a 
    by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
      (auto simp: dghm_field_simps)
qed

lemma cf_smcf_eqI:
  assumes "π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "𝔄 = β„­"
    and "𝔅 = 𝔇"
    and "cf_smcf π”Š = cf_smcf 𝔉"
  shows "π”Š = 𝔉"
proof(rule cf_eqI)
  from assms(5) have 
    "cf_smcf π”Šβ¦‡ObjMap⦈ = cf_smcf 𝔉⦇ObjMap⦈"
    "cf_smcf π”Šβ¦‡ArrMap⦈ = cf_smcf 𝔉⦇ArrMap⦈"
    by simp_all
  then show "π”Šβ¦‡ObjMap⦈ = 𝔉⦇ObjMap⦈" "π”Šβ¦‡ArrMap⦈ = 𝔉⦇ArrMap⦈"
    unfolding slicing_simps by simp_all
qed (auto intro: assms(1,2) simp: assms(3-5))

lemma (in is_functor) cf_def: "𝔉 = [𝔉⦇ObjMap⦈, 𝔉⦇ArrMap⦈, 𝔉⦇HomDom⦈, 𝔉⦇HomCod⦈]∘"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ 𝔉 = 4β„•" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
  have dom_rhs: "π’Ÿβˆ˜ [𝔉⦇Obj⦈, 𝔉⦇Arr⦈, 𝔉⦇Dom⦈, 𝔉⦇Cod⦈]∘ = 4β„•"
    by (simp add: nat_omega_simps)
  then show "π’Ÿβˆ˜ 𝔉 = π’Ÿβˆ˜ [𝔉⦇ObjMap⦈, 𝔉⦇ArrMap⦈, 𝔉⦇HomDom⦈, 𝔉⦇HomCod⦈]∘"
    unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
  show "a ∈∘ π’Ÿβˆ˜ 𝔉 ⟹ 𝔉⦇a⦈ = [𝔉⦇ObjMap⦈, 𝔉⦇ArrMap⦈, 𝔉⦇HomDom⦈, 𝔉⦇HomCod⦈]βˆ˜β¦‡a⦈" 
    for a
    by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
      (simp_all add: nat_omega_simps)
qed (auto simp: vsv_axioms)


textβ€ΉSize.β€Ί

lemma (in is_functor) cf_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"  
  shows "𝔉 ∈∘ Vset Ξ²"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  note [cat_cs_intros] = 
    cf_ObjMap_in_Vset 
    cf_ArrMap_in_Vset 
    HomDom.cat_in_Vset 
    HomCod.cat_in_Vset
  from assms(2) show ?thesis
    by (subst cf_def) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed

lemma (in is_functor) cf_is_functor_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "𝔉 : 𝔄 ↦↦CΞ² 𝔅"
  by (rule is_functorI)
    (
      auto simp:
        cat_cs_simps
        assms 
        vfsequence_axioms
        cf_is_semifunctor_if_ge_Limit
        HomDom.cat_category_if_ge_Limit
        HomCod.cat_category_if_ge_Limit
        intro: cat_cs_intros 
    )

lemma small_all_cfs[simp]: "small {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}"
proof(cases ‹𝒡 Ξ±β€Ί)
  case True
  from is_functor.cf_in_Vset show ?thesis
    by (intro down[of _ β€ΉVset (Ξ± + Ο‰)β€Ί])
      (auto simp: True 𝒡.𝒡_Limit_Ξ±Ο‰ 𝒡.𝒡_Ο‰_Ξ±Ο‰ 𝒡.intro 𝒡.𝒡_Ξ±_Ξ±Ο‰)
next
  case False
  then have "{𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅} = {}" by auto
  then show ?thesis by simp
qed

lemma (in is_functor) cf_in_Vset_7: "𝔉 ∈∘ Vset (Ξ± + 7β„•)"
proof-
  note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
    cf_ObjMap_vsubset_Vset 
    cf_ArrMap_vsubset_Vset
  from HomDom.cat_category_in_Vset_4 have [cat_cs_intros]:
    "𝔄 ∈∘ Vset (succ (succ (succ (succ Ξ±))))"
    by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
  from HomCod.cat_category_in_Vset_4 have [cat_cs_intros]:
    "𝔅 ∈∘ Vset (succ (succ (succ (succ Ξ±))))"
    by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
  show ?thesis
    by (subst cf_def, succ_of_numeral)
      (
        cs_concl 
          cs_simp: plus_V_succ_right V_cs_simps cat_cs_simps 
          cs_intro: cat_cs_intros V_cs_intros
      )
qed

lemma (in 𝒡) all_cfs_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "all_cfs α ∈∘ Vset β"
proof(rule vsubset_in_VsetI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "all_cfs Ξ± βŠ†βˆ˜ Vset (Ξ± + 7β„•)"
  proof(intro vsubsetI)
    fix 𝔉 assume "𝔉 ∈∘ all_cfs Ξ±"
    then obtain 𝔄 𝔅 where 𝔉: "𝔉 : 𝔄 ↦↦CΞ± 𝔅" by clarsimp
    interpret is_functor Ξ± 𝔄 𝔅 𝔉 using 𝔉 by simp
    show "𝔉 ∈∘ Vset (Ξ± + 7β„•)" by (rule cf_in_Vset_7)
  qed
  from assms(2) show "Vset (Ξ± + 7β„•) ∈∘ Vset Ξ²"
    by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed

lemma small_cfs[simp]: "small {𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}"
  by (rule down[of _ β€Ήset {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}β€Ί]) auto



subsectionβ€ΉOpposite functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-2 in \cite{mac_lane_categories_2010}.β€Ί

definition op_cf :: "V β‡’ V"
  where "op_cf 𝔉 =
    [𝔉⦇ObjMap⦈, 𝔉⦇ArrMap⦈, op_cat (𝔉⦇HomDom⦈), op_cat (𝔉⦇HomCod⦈)]∘"


textβ€ΉComponents.β€Ί

lemma op_cf_components[cat_op_simps]:
  shows "op_cf 𝔉⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    and "op_cf 𝔉⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
    and "op_cf 𝔉⦇HomDom⦈ = op_cat (𝔉⦇HomDom⦈)"
    and "op_cf 𝔉⦇HomCod⦈ = op_cat (𝔉⦇HomCod⦈)"
  unfolding op_cf_def dghm_field_simps by (auto simp: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cf_smcf_op_cf[slicing_commute]: "op_smcf (cf_smcf 𝔉) = cf_smcf (op_cf 𝔉)"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (op_smcf (cf_smcf 𝔉)) = 4β„•"
    unfolding op_smcf_def by (auto simp: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (cf_smcf (op_cf 𝔉)) = 4β„•"
    unfolding cf_smcf_def by (auto simp: nat_omega_simps)
  show "π’Ÿβˆ˜ (op_smcf (cf_smcf 𝔉)) = π’Ÿβˆ˜ (cf_smcf (op_cf 𝔉))"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (op_smcf (cf_smcf 𝔉)) ⟹ 
    op_smcf (cf_smcf 𝔉)⦇a⦈ = cf_smcf (op_cf 𝔉)⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral,
        unfold cf_smcf_def op_cf_def op_smcf_def dghm_field_simps
      )
      (auto simp: nat_omega_simps slicing_commute)
qed (auto simp: cf_smcf_def op_smcf_def)


textβ€ΉElementary properties.β€Ί

lemma op_cf_vsv[cat_op_intros]: "vsv (op_cf 𝔉)" unfolding op_cf_def by auto


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in is_functor) is_functor_op: "op_cf 𝔉 : op_cat 𝔄 ↦↦CΞ± op_cat 𝔅"
proof(intro is_functorI, unfold cat_op_simps)
  show "vfsequence (op_cf 𝔉)" unfolding op_cf_def by simp
  show "vcard (op_cf 𝔉) = 4β„•" 
    unfolding op_cf_def by (auto simp: nat_omega_simps)
  fix c assume "c ∈∘ 𝔄⦇Obj⦈"
  then show "𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈"
    unfolding cat_op_simps by (auto intro: cat_cs_intros)
qed 
  (
    auto simp: 
      cat_cs_simps
      slicing_commute[symmetric]
      is_semifunctor.is_semifunctor_op 
      cf_is_semifunctor
      HomCod.category_op 
      HomDom.category_op
  )

lemma (in is_functor) is_functor_op'[cat_op_intros]: 
  assumes "𝔄' = op_cat 𝔄" and "𝔅' = op_cat 𝔅"
  shows "op_cf 𝔉 : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms(1,2) by (rule is_functor_op)

lemmas is_functor_op[cat_op_intros] = is_functor.is_functor_op'

lemma (in is_functor) cf_op_cf_op_cf[cat_op_simps]: "op_cf (op_cf 𝔉) = 𝔉" 
proof(rule cf_eqI[of Ξ± 𝔄 𝔅 _ 𝔄 𝔅], unfold cat_op_simps)
  show "op_cf (op_cf 𝔉) : 𝔄 ↦↦CΞ± 𝔅"
    by 
      (
        metis 
          HomCod.cat_op_cat_op_cat 
          HomDom.cat_op_cat_op_cat 
          is_functor.is_functor_op 
          is_functor_op
      )
qed (auto simp: cat_cs_intros)

lemmas cf_op_cf_op_cf[cat_op_simps] = is_functor.cf_op_cf_op_cf

lemma eq_op_cf_iff[cat_op_simps]: 
  assumes "π”Š : 𝔄 ↦↦CΞ± 𝔅" and "𝔉 : β„­ ↦↦CΞ± 𝔇"
  shows "op_cf π”Š = op_cf 𝔉 ⟷ π”Š = 𝔉"
proof
  interpret L: is_functor Ξ± 𝔄 𝔅 π”Š by (rule assms(1))
  interpret R: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(2))
  assume prems: "op_cf π”Š = op_cf 𝔉"
  show "π”Š = 𝔉"
  proof(rule cf_eqI[OF assms])
    from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf show 
      "π”Šβ¦‡ObjMap⦈ = 𝔉⦇ObjMap⦈" "π”Šβ¦‡ArrMap⦈ = 𝔉⦇ArrMap⦈"
      by metis+
    from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf have 
      "π”Šβ¦‡HomDom⦈ = 𝔉⦇HomDom⦈" "π”Šβ¦‡HomCod⦈ = 𝔉⦇HomCod⦈"
      by auto
    then show "𝔄 = β„­" "𝔅 = 𝔇" by (simp_all add: cat_cs_simps)
  qed
qed auto



subsectionβ€ΉComposition of covariant functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

abbreviation (input) cf_comp :: "V β‡’ V β‡’ V" (infixl "∘CF" 55)
  where "cf_comp ≑ dghm_comp"


textβ€ΉSlicing.β€Ί

lemma cf_smcf_smcf_comp[slicing_commute]: 
  "cf_smcf π”Š ∘SMCF cf_smcf 𝔉 = cf_smcf (π”Š ∘CF 𝔉)"
  unfolding dghm_comp_def cf_smcf_def dghm_field_simps 
  by (simp add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_comp_ObjMap_vsv[cat_cs_intros]: 
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "vsv ((π”Š ∘CF 𝔉)⦇ObjMap⦈)"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_comp_ObjMap_vsv
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute
          ]
      )
qed

lemma cf_comp_ObjMap_vdomain[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ ((π”Š ∘CF 𝔉)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_comp_ObjMap_vdomain
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute
          ]
      )
qed

lemma cf_comp_ObjMap_vrange:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((π”Š ∘CF 𝔉)⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_comp_ObjMap_vrange
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute
          ]
      )
qed

lemma cf_comp_ObjMap_app[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and [simp]: "a ∈∘ 𝔄⦇Obj⦈"
  shows "(π”Š ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_comp_ObjMap_app
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute, 
            OF assms(3)
          ]
      )
qed


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_comp_ArrMap_vsv[cat_cs_intros]: 
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "vsv ((π”Š ∘CF 𝔉)⦇ArrMap⦈)"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis 
    by 
      (
        rule smcf_comp_ArrMap_vsv
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute
          ]
      )
qed

lemma cf_comp_ArrMap_vdomain[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ ((π”Š ∘CF 𝔉)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis 
    by 
      (
        rule smcf_comp_ArrMap_vdomain
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute
          ]
      )
qed

lemma cf_comp_ArrMap_vrange:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((π”Š ∘CF 𝔉)⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_comp_ArrMap_vrange
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute
          ]
      )
qed

lemma cf_comp_ArrMap_app[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and [simp]: "f ∈∘ 𝔄⦇Arr⦈"
  shows "(π”Š ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡f⦈⦈"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_comp_ArrMap_app
          [
            OF L.cf_is_semifunctor R.cf_is_semifunctor, 
            unfolded slicing_simps slicing_commute,
            OF assms(3)
          ]
      )
qed


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma cf_comp_is_functorI[cat_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­"
proof-
  interpret L: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1))
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
  proof(rule is_functorI, unfold dghm_comp_components(3,4))
    show "vfsequence (π”Š ∘CF 𝔉)" by (simp add: dghm_comp_def)
    show "vcard (π”Š ∘CF 𝔉) = 4β„•"  
      unfolding dghm_comp_def by (simp add: nat_omega_simps)
    show "cf_smcf (π”Š ∘CF 𝔉) : cat_smc 𝔄 ↦↦SMCΞ± cat_smc β„­"
      unfolding cf_smcf_smcf_comp[symmetric] 
      by (cs_concl cs_intro: smc_cs_intros slicing_intros cat_cs_intros)
    fix c assume "c ∈∘ 𝔄⦇Obj⦈"
    with assms show 
      "(π”Š ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡(π”Š ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: cat_cs_simps intro: cat_cs_intros)
qed

lemma cf_comp_assoc[cat_cs_simps]:
  assumes "β„Œ : β„­ ↦↦CΞ± 𝔇" and "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "(β„Œ ∘CF π”Š) ∘CF 𝔉 = β„Œ ∘CF (π”Š ∘CF 𝔉)"
proof(rule cf_eqI[of Ξ± 𝔄 𝔇 _ 𝔄 𝔇])
  interpret β„Œ: is_functor Ξ± β„­ 𝔇 β„Œ by (rule assms(1)) 
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2)) 
  interpret 𝔉: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(3)) 
  from 𝔉.is_functor_axioms π”Š.is_functor_axioms β„Œ.is_functor_axioms 
  show "β„Œ ∘CF (π”Š ∘CF 𝔉) : 𝔄 ↦↦CΞ± 𝔇" and "β„Œ ∘CF π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± 𝔇"  
    by (auto simp: cat_cs_simps intro: cat_cs_intros)
qed (simp_all add: dghm_comp_components vcomp_assoc)


textβ€ΉThe opposite of the covariant composition of functors.β€Ί

lemma op_cf_cf_comp[cat_op_simps]: "op_cf (π”Š ∘CF 𝔉) = op_cf π”Š ∘CF op_cf 𝔉"
  unfolding dghm_comp_def op_cf_def dghm_field_simps
  by (simp add: nat_omega_simps)



subsectionβ€ΉComposition of contravariant functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee section 1.2 in \cite{bodo_categories_1970}.β€Ί

definition cf_cn_comp :: "V β‡’ V β‡’ V" (infixl "CF∘" 55)
  where "π”Š CF∘ 𝔉 =
    [
      π”Šβ¦‡ObjMap⦈ ∘∘ 𝔉⦇ObjMap⦈,
      π”Šβ¦‡ArrMap⦈ ∘∘ 𝔉⦇ArrMap⦈,
      op_cat (𝔉⦇HomDom⦈),
      π”Šβ¦‡HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_cn_comp_components:
  shows "(π”Š CF∘ 𝔉)⦇ObjMap⦈ = π”Šβ¦‡ObjMap⦈ ∘∘ 𝔉⦇ObjMap⦈"
    and "(π”Š CF∘ 𝔉)⦇ArrMap⦈ = π”Šβ¦‡ArrMap⦈ ∘∘ 𝔉⦇ArrMap⦈"
    and [cat_cn_cs_simps]: "(π”Š CF∘ 𝔉)⦇HomDom⦈ = op_cat (𝔉⦇HomDom⦈)"
    and [cat_cn_cs_simps]: "(π”Š CF∘ 𝔉)⦇HomCod⦈ = π”Šβ¦‡HomCod⦈"
  unfolding cf_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cf_smcf_cf_cn_comp[slicing_commute]: 
  "cf_smcf π”Š SMCF∘ cf_smcf 𝔉 = cf_smcf (π”Š CF∘ 𝔉)"
  unfolding smcf_cn_comp_def cf_cn_comp_def cf_smcf_def  
  by (simp add: nat_omega_simps slicing_commute dghm_field_simps)


subsubsectionβ€ΉObject map: two contravariant functorsβ€Ί

lemma cf_cn_comp_ObjMap_vsv[cat_cn_cs_intros]: 
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "vsv ((π”Š CF∘ 𝔉)⦇ObjMap⦈)"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ObjMap_vsv
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_comp_ObjMap_vdomain[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "π’Ÿβˆ˜ ((π”Š CF∘ 𝔉)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_comp_ObjMap_vdomain
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_comp_ObjMap_vrange:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "β„›βˆ˜ ((π”Š CF∘ 𝔉)⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_comp_ObjMap_vrange
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_comp_ObjMap_app[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅" and "a ∈∘ 𝔄⦇Obj⦈"
  shows "(π”Š CF∘ 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_comp_ObjMap_app
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps, 
            OF assms(3)
          ]
      )
qed


subsubsectionβ€ΉArrow map: two contravariant functorsβ€Ί

lemma cf_cn_comp_ArrMap_vsv[cat_cn_cs_intros]: 
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "vsv ((π”Š CF∘ 𝔉)⦇ArrMap⦈)"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ArrMap_vsv
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_comp_ArrMap_vdomain[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "π’Ÿβˆ˜ ((π”Š CF∘ 𝔉)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_comp_ArrMap_vdomain
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_comp_ArrMap_vrange:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "β„›βˆ˜ ((π”Š CF∘ 𝔉)⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_comp_ArrMap_vrange
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_comp_ArrMap_app[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅" and "a ∈∘ 𝔄⦇Arr⦈"
  shows "(π”Š CF∘ 𝔉)⦇ArrMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡a⦈⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_comp_ArrMap_app
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps,
            OF assms(3)
          ]
      )
qed


subsubsectionβ€ΉObject map: contravariant and covariant functorβ€Ί

lemma cf_cn_cov_comp_ObjMap_vsv[cat_cn_cs_intros]: 
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "vsv ((π”Š CF∘ 𝔉)⦇ObjMap⦈)"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ObjMap_vsv
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_cov_comp_ObjMap_vdomain[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ ((π”Š CF∘ 𝔉)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ObjMap_vdomain
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor,
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_cov_comp_ObjMap_vrange:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((π”Š CF∘ 𝔉)⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ObjMap_vrange
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor,
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_cov_comp_ObjMap_app[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and "a ∈∘ 𝔄⦇Obj⦈"
  shows "(π”Š CF∘ 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ObjMap_app
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor,
            unfolded slicing_commute slicing_simps,
            OF assms(3)
          ]
      )
qed


subsubsectionβ€ΉArrow map: contravariant and covariant functorsβ€Ί

lemma cf_cn_cov_comp_ArrMap_vsv[cat_cn_cs_intros]: 
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "vsv ((π”Š CF∘ 𝔉)⦇ArrMap⦈)"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ArrMap_vsv
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
              R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_cov_comp_ArrMap_vdomain[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ ((π”Š CF∘ 𝔉)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ArrMap_vdomain
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor,
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_cov_comp_ArrMap_vrange:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((π”Š CF∘ 𝔉)⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ArrMap_vrange
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor,
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma cf_cn_cov_comp_ArrMap_app[cat_cn_cs_simps]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and "a ∈∘ 𝔄⦇Arr⦈"
  shows "(π”Š CF∘ 𝔉)⦇ArrMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡a⦈⦈"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1)) 
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by 
      (
        rule smcf_cn_cov_comp_ArrMap_app
          [
            OF 
              L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
              R.cf_is_semifunctor,
            unfolded slicing_commute slicing_simps,
            OF assms(3)
          ]
      )
qed


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma cf_cn_comp_is_functorI[cat_cn_cs_intros]:
  assumes "category Ξ± 𝔄" and "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "π”Š CF∘ 𝔉 : 𝔄 ↦↦CΞ± β„­"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(2))
  interpret R: is_functor Ξ± β€Ήop_cat 𝔄› 𝔅 𝔉 by (rule assms(3))
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  show ?thesis
  proof(rule is_functorI, unfold cf_cn_comp_components(3,4) cat_op_simps)
    show "vfsequence (π”Š CF∘ 𝔉)"
      unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
    show "vcard (π”Š CF∘ 𝔉) = 4β„•"
      unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
    from assms(1) L.cf_is_semifunctor R.cf_is_semifunctor show 
      "cf_smcf (π”Š CF∘ 𝔉) : cat_smc 𝔄 ↦↦SMCΞ± cat_smc β„­"
      unfolding cf_smcf_cf_cn_comp[symmetric] 
      by 
        (
          cs_concl cs_intro: 
            cat_cs_intros slicing_intros smc_cn_cs_intros
        )
    fix c assume "c ∈∘ 𝔄⦇Obj⦈"
    with assms show 
      "(π”Š CF∘ 𝔉)⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡(π”Š CF∘ 𝔉)⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_op_simps cat_cn_cs_simps cs_intro: cat_cs_intros
        )
  qed (auto simp: cat_cs_simps cat_cs_intros cat_op_simps)
qed


textβ€ΉSee section 1.2 in \cite{bodo_categories_1970}).β€Ί

lemma cf_cn_cov_comp_is_functor[cat_cn_cs_intros]:
  assumes "π”Š : 𝔅 C↦↦α β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π”Š CF∘ 𝔉 : 𝔄 C↦↦α β„­"
proof-
  interpret L: is_functor Ξ± β€Ήop_cat 𝔅› β„­ π”Š by (rule assms(1))
  interpret R: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
  proof
    (
      rule is_functorI, 
      unfold cf_cn_comp_components(3,4) cat_op_simps slicing_commute[symmetric]
    )
    show "vfsequence (π”Š CF∘ 𝔉)" unfolding cf_cn_comp_def by simp
    show "vcard (π”Š CF∘ 𝔉) = 4β„•"
      unfolding cf_cn_comp_def by (auto simp: nat_omega_simps)
    from L.cf_is_semifunctor show 
      "cf_smcf π”Š SMCF∘ cf_smcf 𝔉 : op_smc (cat_smc 𝔄) ↦↦SMCΞ± cat_smc β„­"
      by (cs_concl cs_intro: cat_cs_intros slicing_intros smc_cs_intros)
    fix c assume "c ∈∘ 𝔄⦇Obj⦈"
    with assms show "(π”Š CF∘ 𝔉)⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡(π”Š CF∘ 𝔉)⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_cn_cs_simps 
            cs_intro: cat_cs_intros
        )
  qed (auto simp: cat_cs_simps cat_cs_intros)
qed


textβ€ΉSee section 1.2 in \cite{bodo_categories_1970}.β€Ί

lemma cf_cov_cn_comp_is_functor[cat_cn_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 C↦↦α 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 C↦↦α β„­"
  using assms by (rule cf_comp_is_functorI)


textβ€ΉThe opposite of the contravariant composition of functors.β€Ί

lemma op_cf_cf_cn_comp[cat_op_simps]: "op_cf (π”Š CF∘ 𝔉) = op_cf π”Š CF∘ op_cf 𝔉"
  unfolding op_cf_def cf_cn_comp_def dghm_field_simps 
  by (auto simp: nat_omega_simps)



subsectionβ€ΉIdentity functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.β€Ί

abbreviation (input) cf_id :: "V β‡’ V" where "cf_id ≑ dghm_id"


textβ€ΉSlicing.β€Ί

lemma cf_smcf_cf_id[slicing_commute]: "smcf_id (cat_smc β„­) = cf_smcf (cf_id β„­)"
  unfolding dghm_id_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
  by (simp add: nat_omega_simps)

context category
begin

interpretation smc: semicategory Ξ± β€Ήcat_smc β„­β€Ί by (rule cat_semicategory)

lemmas_with [unfolded slicing_simps]:
  cat_smcf_id_is_semifunctor = smc.smc_smcf_id_is_semifunctor

end


subsubsectionβ€ΉObject mapβ€Ί

lemmas [cat_cs_simps] = dghm_id_ObjMap_app


subsubsectionβ€ΉArrow mapβ€Ί

lemmas [cat_cs_simps] = dghm_id_ArrMap_app


subsubsectionβ€ΉOpposite of an identity functor.β€Ί

lemma op_cf_cf_id[cat_op_simps]: "op_cf (cf_id β„­) = cf_id (op_cat β„­)"
  unfolding dghm_id_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
  by (auto simp: nat_omega_simps)


subsubsectionβ€ΉAn identity functor is a functorβ€Ί

lemma (in category) cat_cf_id_is_functor: "cf_id β„­ : β„­ ↦↦CΞ± β„­"
proof(rule is_functorI, unfold dghm_id_components)
  from cat_smcf_id_is_semifunctor show 
    "cf_smcf (cf_id β„­) : cat_smc β„­ ↦↦SMCΞ± cat_smc β„­"
    by (simp add: slicing_commute)
  from cat_CId_is_arr show 
    "c ∈∘ ℭ⦇Obj⦈ ⟹ vid_on (ℭ⦇Arr⦈)⦇ℭ⦇CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡vid_on (ℭ⦇Obj⦈)⦇c⦈⦈"
    for c
    by auto
qed (auto simp: dghm_id_def nat_omega_simps cat_cs_intros)

lemma (in category) cat_cf_id_is_functor': 
  assumes "𝔄 = β„­" and "𝔅 = β„­"
  shows "cf_id β„­ : 𝔄 ↦↦CΞ± 𝔅"
  unfolding assms by (rule cat_cf_id_is_functor)

lemmas [cat_cs_intros] = category.cat_cf_id_is_functor'


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in is_functor) cf_cf_comp_cf_id_left[cat_cs_simps]: "cf_id 𝔅 ∘CF 𝔉 = 𝔉"
  ―‹See Chapter I-3 in \cite{mac_lane_categories_2010}).β€Ί
  by 
    (
      rule cf_eqI,
      unfold dghm_id_components dghm_comp_components dghm_id_components
    )
    (auto intro: cat_cs_intros simp: cf_ArrMap_vrange cf_ObjMap_vrange)

lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_left

lemma (in is_functor) cf_cf_comp_cf_id_right[cat_cs_simps]: "𝔉 ∘CF cf_id 𝔄 = 𝔉"
  ―‹See Chapter I-3 in \cite{mac_lane_categories_2010}).β€Ί
  by 
    (
      rule cf_eqI, 
      unfold dghm_id_components dghm_comp_components dghm_id_components
    )
    (
      auto 
        intro: cat_cs_intros 
        simp: cat_cs_simps cf_ArrMap_vrange cf_ObjMap_vrange 
    )

lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_right



subsectionβ€ΉConstant functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III-3 in \cite{mac_lane_categories_2010}.β€Ί

abbreviation cf_const :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_const β„­ 𝔇 a ≑ smcf_const β„­ 𝔇 a (𝔇⦇CIdβ¦ˆβ¦‡a⦈)"


textβ€ΉSlicing.β€Ί

lemma cf_smcf_cf_const[slicing_commute]: 
  "smcf_const (cat_smc β„­) (cat_smc 𝔇) a (𝔇⦇CIdβ¦ˆβ¦‡a⦈) = cf_smcf (cf_const β„­ 𝔇 a)"
  unfolding 
    dghm_const_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
  by (simp add: nat_omega_simps)


subsubsectionβ€ΉObject map and arrow mapβ€Ί

context
  fixes 𝔇 a :: V
begin

lemmas_with [where 𝔇=𝔇 and a=a and f=‹𝔇⦇CIdβ¦ˆβ¦‡aβ¦ˆβ€Ί, cat_cs_simps]: 
  dghm_const_ObjMap_app
  dghm_const_ArrMap_app

end


subsubsectionβ€ΉOpposite constant functorβ€Ί

lemma op_cf_cf_const[cat_op_simps]:
  "op_cf (cf_const β„­ 𝔇 a) = cf_const (op_cat β„­) (op_cat 𝔇) a"
  unfolding dghm_const_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
  by (auto simp: nat_omega_simps)


subsubsectionβ€ΉA constant functor is a functorβ€Ί

lemma cf_const_is_functor: 
  assumes "category Ξ± β„­" and "category Ξ± 𝔇" and "a ∈∘ 𝔇⦇Obj⦈" 
  shows "cf_const β„­ 𝔇 a : β„­ ↦↦CΞ± 𝔇"
proof-
  interpret β„­: category Ξ± β„­ by (rule assms(1))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(2))
  show ?thesis
  proof(intro is_functorI, tacticβ€Ήdistinct_subgoals_tacβ€Ί)
    show "vfsequence (dghm_const β„­ 𝔇 a (𝔇⦇CIdβ¦ˆβ¦‡a⦈))"
      unfolding dghm_const_def by simp
    show "vcard (cf_const β„­ 𝔇 a) = 4β„•"
      unfolding dghm_const_def by (simp add: nat_omega_simps)
    from assms show "cf_smcf (cf_const β„­ 𝔇 a) : cat_smc β„­ ↦↦SMCΞ± cat_smc 𝔇"
      by 
        ( 
          cs_concl
            cs_simp: cat_cs_simps slicing_simps slicing_commute[symmetric] 
            cs_intro: smc_cs_intros cat_cs_intros slicing_intros
        )
    fix c assume "c ∈∘ ℭ⦇Obj⦈"
    with assms show 
      "cf_const β„­ 𝔇 a⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔇⦇CIdβ¦ˆβ¦‡cf_const β„­ 𝔇 a⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: dghm_const_components assms)
qed 

lemma cf_const_is_functor'[cat_cs_intros]: 
  assumes "category Ξ± β„­" 
    and "category Ξ± 𝔇" 
    and "a ∈∘ 𝔇⦇Obj⦈" 
    and "𝔄 = β„­"
    and "𝔅 = 𝔇"
  shows "cf_const β„­ 𝔇 a : 𝔄 ↦↦CΞ± 𝔅"
  using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_functor)



subsectionβ€ΉFaithful functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).β€Ί

locale is_ft_functor = is_functor Ξ± 𝔄 𝔅 𝔉 for Ξ± 𝔄 𝔅 𝔉 + 
  assumes ft_cf_is_ft_semifunctor[slicing_intros]: 
    "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.faithfulΞ± cat_smc 𝔅"

syntax "_is_ft_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦↦C.faithfulΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ↦↦C.faithfulΞ± 𝔅" β‡Œ "CONST is_ft_functor Ξ± 𝔄 𝔅 𝔉"

lemma (in is_ft_functor) ft_cf_is_ft_functor':
  assumes "𝔄' = cat_smc 𝔄" and "𝔅' = cat_smc 𝔅"
  shows "cf_smcf 𝔉 : 𝔄' ↦↦SMC.faithfulΞ± 𝔅'"
  unfolding assms by (rule ft_cf_is_ft_semifunctor)

lemmas [slicing_intros] = is_ft_functor.ft_cf_is_ft_functor'


textβ€ΉRules.β€Ί

lemma (in is_ft_functor) is_ft_functor_axioms'[cf_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔉 : 𝔄' ↦↦C.faithfulΞ±' 𝔅'"
  unfolding assms by (rule is_ft_functor_axioms)

mk_ide rf is_ft_functor_def[unfolded is_ft_functor_axioms_def]
  |intro is_ft_functorI|
  |dest is_ft_functorD[dest]|
  |elim is_ft_functorE[elim]|

lemmas [cf_cs_intros] = is_ft_functorD(1)

lemma is_ft_functorI':
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "β‹€a b. ⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔄⦇Obj⦈ ⟧ ⟹ v11 (𝔉⦇ArrMap⦈ β†Ύl∘ Hom 𝔄 a b)"
  shows "𝔉 : 𝔄 ↦↦C.faithfulΞ± 𝔅"
  using assms
  by (intro is_ft_functorI)
    (
      simp_all add: 
        assms(1) 
        is_ft_semifunctorI'[OF is_functorD(6)[
          OF assms(1)], unfolded slicing_simps
          ]
    )

lemma is_ft_functorD':
  assumes "𝔉 : 𝔄 ↦↦C.faithfulΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "β‹€a b. ⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔄⦇Obj⦈ ⟧ ⟹ v11 (𝔉⦇ArrMap⦈ β†Ύl∘ Hom 𝔄 a b)"
  by 
    (
      simp_all add: 
        is_ft_functorD[OF assms(1)] 
        is_ft_semifunctorD'(2)[
          OF is_ft_functorD(2)[OF assms(1)], unfolded slicing_simps
          ]
    )

lemma is_ft_functorE':
  assumes "𝔉 : 𝔄 ↦↦C.faithfulΞ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "β‹€a b. ⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔄⦇Obj⦈ ⟧ ⟹ v11 (𝔉⦇ArrMap⦈ β†Ύl∘ Hom 𝔄 a b)"
  using assms by (simp_all add: is_ft_functorD')


textβ€ΉElementary properties.β€Ί

context is_ft_functor
begin

interpretation smcf: is_ft_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
  by (rule ft_cf_is_ft_semifunctor) 

lemmas_with [unfolded slicing_simps]:
  ft_cf_v11_on_Hom = smcf.ft_smcf_v11_on_Hom

end


subsubsectionβ€ΉOpposite faithful functor.β€Ί

lemma (in is_ft_functor) is_ft_functor_op': 
  "op_cf 𝔉 : op_cat 𝔄 ↦↦C.faithfulΞ± op_cat 𝔅"   
  by (rule is_ft_functorI, unfold slicing_commute[symmetric])
    (
      simp_all add: 
        is_functor_op is_ft_semifunctor.is_ft_semifunctor_op 
        ft_cf_is_ft_semifunctor
    )

lemma (in is_ft_functor) is_ft_functor_op: 
  assumes "𝔄' = op_cat 𝔄" and "𝔅' = op_cat 𝔅"
  shows "op_cf 𝔉 : op_cat 𝔄 ↦↦C.faithfulΞ± op_cat 𝔅"   
  unfolding assms by (rule is_ft_functor_op')

lemmas is_ft_functor_op[cat_op_intros] = is_ft_functor.is_ft_functor_op'


subsubsectionβ€ΉThe composition of faithful functors is a faithful functorβ€Ί

lemma cf_comp_is_ft_functor[cf_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦C.faithfulΞ± β„­" and "𝔉 : 𝔄 ↦↦C.faithfulΞ± 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 ↦↦C.faithfulΞ± β„­"
proof(intro is_ft_functorI)
  interpret π”Š: is_ft_functor Ξ± 𝔅 β„­ π”Š by (simp add: assms(1))
  interpret 𝔉: is_ft_functor Ξ± 𝔄 𝔅 𝔉 by (simp add: assms(2))
  from 𝔉.is_functor_axioms π”Š.is_functor_axioms show "π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  then interpret is_functor Ξ± 𝔄 β„­ β€Ήπ”Š ∘CF 𝔉› .
  show "cf_smcf (π”Š ∘CF 𝔉) : cat_smc 𝔄 ↦↦SMC.faithfulΞ± cat_smc β„­" 
    by 
      ( 
        cs_concl 
          cs_simp: slicing_commute[symmetric] 
          cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
      )
qed



subsectionβ€ΉFull functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).β€Ί

locale is_fl_functor = is_functor Ξ± 𝔄 𝔅 𝔉 for Ξ± 𝔄 𝔅 𝔉 + 
  assumes fl_cf_is_fl_semifunctor:
    "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.fullΞ± cat_smc 𝔅"

syntax "_is_fl_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦↦C.fullΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ↦↦C.fullΞ± 𝔅" β‡Œ "CONST is_fl_functor Ξ± 𝔄 𝔅 𝔉"

lemma (in is_fl_functor) fl_cf_is_fl_functor'[slicing_intros]:
  assumes "𝔄' = cat_smc 𝔄" and "𝔅' = cat_smc 𝔅"
  shows "cf_smcf 𝔉 : 𝔄' ↦↦SMC.fullΞ± 𝔅'"
  unfolding assms by (rule fl_cf_is_fl_semifunctor)

lemmas [slicing_intros] = is_fl_functor.fl_cf_is_fl_semifunctor


textβ€ΉRules.β€Ί

lemma (in is_fl_functor) is_fl_functor_axioms'[cf_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔉 : 𝔄' ↦↦C.fullΞ±' 𝔅'"
  unfolding assms by (rule is_fl_functor_axioms)

mk_ide rf is_fl_functor_def[unfolded is_fl_functor_axioms_def]
  |intro is_fl_functorI|
  |dest is_fl_functorD[dest]|
  |elim is_fl_functorE[elim]|

lemmas [cf_cs_intros] = is_fl_functorD(1)

lemma is_fl_functorI':
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "β‹€a b. ⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔄⦇Obj⦈ ⟧ ⟹
    𝔉⦇ArrMap⦈ `∘ (Hom 𝔄 a b) = Hom 𝔅 (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
  shows "𝔉 : 𝔄 ↦↦C.fullΞ± 𝔅"
  using assms
  by (intro is_fl_functorI)
    (
      simp_all add: 
        assms(1) 
        is_fl_semifunctorI'[
          OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
          ]
    )

lemma is_fl_functorD':
  assumes "𝔉 : 𝔄 ↦↦C.fullΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "β‹€a b. ⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔄⦇Obj⦈ ⟧ ⟹
    𝔉⦇ArrMap⦈ `∘ (Hom 𝔄 a b) = Hom 𝔅 (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
  by 
    (
      simp_all add: 
        is_fl_functorD[OF assms(1)] 
        is_fl_semifunctorD'(2)[
          OF is_fl_functorD(2)[OF assms(1)], unfolded slicing_simps
          ]
    )

lemma is_fl_functorE':
  assumes "𝔉 : 𝔄 ↦↦C.fullΞ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "β‹€a b. ⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔄⦇Obj⦈ ⟧ ⟹ 
    𝔉⦇ArrMap⦈ `∘ (Hom 𝔄 a b) = Hom 𝔅 (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
  using assms by (simp_all add: is_fl_functorD')


textβ€ΉElementary properties.β€Ί

context is_fl_functor
begin

interpretation smcf: is_fl_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
  by (rule fl_cf_is_fl_semifunctor) 

lemmas_with [unfolded slicing_simps]:
  fl_cf_surj_on_Hom = smcf.fl_smcf_surj_on_Hom

end


subsubsectionβ€ΉOpposite full functorβ€Ί

lemma (in is_fl_functor) is_fl_functor_op[cat_op_intros]: 
  "op_cf 𝔉 : op_cat 𝔄 ↦↦C.fullΞ± op_cat 𝔅"    
  by (rule is_fl_functorI, unfold slicing_commute[symmetric])
    (simp_all add: cat_op_intros smc_op_intros slicing_intros)

lemmas is_fl_functor_op[cat_op_intros] = is_fl_functor.is_fl_functor_op


subsubsectionβ€ΉThe composition of full functor is a full functorβ€Ί

lemma cf_comp_is_fl_functor[cf_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦C.fullΞ± β„­" and "𝔉 : 𝔄 ↦↦C.fullΞ± 𝔅" 
  shows "π”Š ∘CF 𝔉 : 𝔄 ↦↦C.fullΞ± β„­"
proof(intro is_fl_functorI)
  interpret 𝔉: is_fl_functor Ξ± 𝔄 𝔅 𝔉 using assms(2) by simp
  interpret π”Š: is_fl_functor Ξ± 𝔅 β„­ π”Š using assms(1) by simp
  from 𝔉.is_functor_axioms π”Š.is_functor_axioms show "π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­" 
    by (cs_concl cs_intro: cat_cs_intros)
  show "cf_smcf (π”Š ∘CF 𝔉) : cat_smc 𝔄 ↦↦SMC.fullΞ± cat_smc β„­" 
    by 
      (
        cs_concl 
          cs_simp: slicing_commute[symmetric] 
          cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
      )
qed



subsectionβ€ΉFully faithful functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).β€Ί

locale is_ff_functor = is_ft_functor Ξ± 𝔄 𝔅 𝔉 + is_fl_functor Ξ± 𝔄 𝔅 𝔉
  for Ξ± 𝔄 𝔅 𝔉

syntax "_is_ff_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦↦C.ffΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ↦↦C.ffΞ± 𝔅" β‡Œ "CONST is_ff_functor Ξ± 𝔄 𝔅 𝔉"


textβ€ΉRules.β€Ί

mk_ide rf is_ff_functor_def
  |intro is_ff_functorI|
  |dest is_ff_functorD[dest]|
  |elim is_ff_functorE[elim]|

lemmas [cf_cs_intros] = is_ff_functorD


textβ€ΉElementary properties.β€Ί

lemma (in is_ff_functor) ff_cf_is_ff_semifunctor:
  "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.ffΞ± cat_smc 𝔅"
  by (rule is_ff_semifunctorI) (auto intro: slicing_intros)

lemma (in is_ff_functor) ff_cf_is_ff_semifunctor'[slicing_intros]:
  assumes "𝔄' = cat_smc 𝔄" and "𝔅' = cat_smc 𝔅"
  shows "cf_smcf 𝔉 : 𝔄' ↦↦SMC.ffΞ± 𝔅'"
  unfolding assms by (rule ff_cf_is_ff_semifunctor)

lemmas [slicing_intros] = is_ff_functor.ff_cf_is_ff_semifunctor'


subsubsectionβ€ΉOpposite fully faithful functorβ€Ί

lemma (in is_ff_functor) is_ff_functor_op: 
  "op_cf 𝔉 : op_cat 𝔄 ↦↦C.ffΞ± op_cat 𝔅"    
  by (rule is_ff_functorI) (auto simp: is_fl_functor_op is_ft_functor_op)

lemma (in is_ff_functor) is_ff_functor_op'[cat_op_intros]: 
  assumes "𝔄' = op_cat 𝔄" and "𝔅' = op_cat 𝔅"
  shows "op_cf 𝔉 : 𝔄' ↦↦C.ffΞ± 𝔅'"
  unfolding assms by (rule is_ff_functor_op)

lemmas is_ff_functor_op[cat_op_intros] = is_ff_functor.is_ff_functor_op


subsubsectionβ€Ή
The composition of fully faithful functors is a fully faithful functor
β€Ί

lemma cf_comp_is_ff_functor[cf_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦C.ffΞ± β„­" and "𝔉 : 𝔄 ↦↦C.ffΞ± 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 ↦↦C.ffΞ± β„­"
  using assms 
  by (intro is_ff_functorI, elim is_ff_functorE) (auto simp: cf_cs_intros)



subsectionβ€ΉIsomorphism of categoriesβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).β€Ί

locale is_iso_functor = is_functor Ξ± 𝔄 𝔅 𝔉 for Ξ± 𝔄 𝔅 𝔉 + 
  assumes iso_cf_is_iso_semifunctor: 
    "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.isoΞ± cat_smc 𝔅"

syntax "_is_iso_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦↦C.isoΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅" β‡Œ "CONST is_iso_functor Ξ± 𝔄 𝔅 𝔉"

lemma (in is_iso_functor) iso_cf_is_iso_semifunctor'[slicing_intros]:
  assumes "𝔄' = cat_smc 𝔄" "𝔅' = cat_smc 𝔅"
  shows "cf_smcf 𝔉 : 𝔄' ↦↦SMC.isoΞ± 𝔅'"
  unfolding assms by (rule iso_cf_is_iso_semifunctor)

lemmas [slicing_intros] = is_iso_semifunctor.iso_smcf_is_iso_dghm'


textβ€ΉRules.β€Ί

lemma (in is_iso_functor) is_iso_functor_axioms'[cf_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔉 : 𝔄' ↦↦C.isoΞ±' 𝔅'"
  unfolding assms by (rule is_iso_functor_axioms)

mk_ide rf is_iso_functor_def[unfolded is_iso_functor_axioms_def]
  |intro is_iso_functorI|
  |dest is_iso_functorD[dest]|
  |elim is_iso_functorE[elim]|

lemma is_iso_functorI':
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "v11 (𝔉⦇ObjMap⦈)"
    and "v11 (𝔉⦇ArrMap⦈)"
    and "β„›βˆ˜ (𝔉⦇ObjMap⦈) = 𝔅⦇Obj⦈"
    and "β„›βˆ˜ (𝔉⦇ArrMap⦈) = 𝔅⦇Arr⦈"
  shows "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  using assms
  by (intro is_iso_functorI)
    (
      simp_all add: 
        assms(1) 
        is_iso_semifunctorI'[
          OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
          ]
    )

lemma is_iso_functorD':
  assumes "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "v11 (𝔉⦇ObjMap⦈)"
    and "v11 (𝔉⦇ArrMap⦈)"
    and "β„›βˆ˜ (𝔉⦇ObjMap⦈) = 𝔅⦇Obj⦈"
    and "β„›βˆ˜ (𝔉⦇ArrMap⦈) = 𝔅⦇Arr⦈"
  by 
    (
      simp_all add: 
        is_iso_functorD[OF assms(1)] 
        is_iso_semifunctorD'(2-5)[
          OF is_iso_functorD(2)[OF assms(1)], unfolded slicing_simps
          ]
    )

lemma is_iso_functorE':
  assumes "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "v11 (𝔉⦇ObjMap⦈)"
    and "v11 (𝔉⦇ArrMap⦈)"
    and "β„›βˆ˜ (𝔉⦇ObjMap⦈) = 𝔅⦇Obj⦈"
    and "β„›βˆ˜ (𝔉⦇ArrMap⦈) = 𝔅⦇Arr⦈"
  using assms by (simp_all add: is_iso_functorD')


textβ€ΉElementary properties.β€Ί

context is_iso_functor
begin

interpretation smcf: is_iso_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
  by (rule iso_cf_is_iso_semifunctor) 

lemmas_with [unfolded slicing_simps]:
  iso_cf_ObjMap_vrange[simp] = smcf.iso_smcf_ObjMap_vrange
  and iso_cf_ArrMap_vrange[simp] = smcf.iso_smcf_ArrMap_vrange

sublocale ObjMap: v11 ‹𝔉⦇ObjMapβ¦ˆβ€Ί
  rewrites "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = 𝔄⦇Obj⦈" and "β„›βˆ˜ (𝔉⦇ObjMap⦈) = 𝔅⦇Obj⦈"
  by (rule smcf.ObjMap.v11_axioms[unfolded slicing_simps]) 
    (simp_all add: cat_cs_simps cf_cs_simps)
  
sublocale ArrMap: v11 ‹𝔉⦇ArrMapβ¦ˆβ€Ί
  rewrites "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = 𝔄⦇Arr⦈" and "β„›βˆ˜ (𝔉⦇ArrMap⦈) = 𝔅⦇Arr⦈"
  by (rule smcf.ArrMap.v11_axioms[unfolded slicing_simps])
    (simp_all add: cat_cs_simps smcf_cs_simps)

lemmas_with [unfolded slicing_simps]:
  iso_cf_Obj_HomDom_if_Obj_HomCod[elim] = 
    smcf.iso_smcf_Obj_HomDom_if_Obj_HomCod
  and iso_cf_Arr_HomDom_if_Arr_HomCod[elim] = 
    smcf.iso_smcf_Arr_HomDom_if_Arr_HomCod
  and iso_cf_ObjMap_eqE[elim] = smcf.iso_smcf_ObjMap_eqE
  and iso_cf_ArrMap_eqE[elim] = smcf.iso_smcf_ArrMap_eqE

end

sublocale is_iso_functor βŠ† is_ff_functor 
proof(intro is_ff_functorI)
  interpret is_iso_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
    by (rule iso_cf_is_iso_semifunctor)
  show "𝔉 : 𝔄 ↦↦C.faithfulΞ± 𝔅" by unfold_locales
  show "𝔉 : 𝔄 ↦↦C.fullΞ± 𝔅" by unfold_locales
qed

lemmas (in is_iso_functor) iso_cf_is_ff_functor = is_ff_functor_axioms
lemmas [cf_cs_intros] = is_iso_functor.iso_cf_is_ff_functor


subsubsectionβ€ΉOpposite isomorphism of categoriesβ€Ί
 
lemma (in is_iso_functor) is_iso_functor_op: 
  "op_cf 𝔉 : op_cat 𝔄 ↦↦C.isoΞ± op_cat 𝔅"   
  by (rule is_iso_functorI, unfold slicing_simps slicing_commute[symmetric]) 
   (simp_all add: cat_op_intros smc_op_intros slicing_intros)

lemma (in is_iso_functor) is_iso_functor_op': 
  assumes "𝔄' = op_cat 𝔄" and "𝔅' = op_cat 𝔅"
  shows "op_cf 𝔉 : op_cat 𝔄 ↦↦C.isoΞ± op_cat 𝔅"   
  unfolding assms by (rule is_iso_functor_op)

lemmas is_iso_functor_op[cat_op_intros] = 
  is_iso_functor.is_iso_functor_op'


subsubsectionβ€Ή
The composition of isomorphisms of categories is an isomorphism of categories
β€Ί

lemma cf_comp_is_iso_functor[cf_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦C.isoΞ± β„­" and "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 ↦↦C.isoΞ± β„­"
proof(intro is_iso_functorI)
  interpret 𝔉: is_iso_functor Ξ± 𝔄 𝔅 𝔉 using assms by auto
  interpret π”Š: is_iso_functor Ξ± 𝔅 β„­ π”Š using assms by auto
  from 𝔉.is_functor_axioms π”Š.is_functor_axioms show "π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­" 
    by (cs_concl cs_intro: cat_cs_intros)
  show "cf_smcf (π”Š ∘CF 𝔉) : cat_smc 𝔄 ↦↦SMC.isoΞ± cat_smc β„­"
    unfolding slicing_commute[symmetric] 
    by (cs_concl cs_intro: smcf_cs_intros slicing_intros)
qed



subsectionβ€ΉInverse functorβ€Ί

abbreviation (input) inv_cf :: "V β‡’ V"
  where "inv_cf ≑ inv_dghm"


textβ€ΉSlicing.β€Ί

lemma dghm_inv_semifunctor[slicing_commute]: 
  "inv_smcf (cf_smcf 𝔉) = cf_smcf (inv_cf 𝔉)"
  unfolding cf_smcf_def inv_dghm_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)

context is_iso_functor
begin

interpretation smcf: is_iso_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
  by (rule iso_cf_is_iso_semifunctor) 

lemmas_with [unfolded slicing_simps slicing_commute]:
  inv_cf_ObjMap_v11 = smcf.inv_smcf_ObjMap_v11
  and inv_cf_ObjMap_vdomain = smcf.inv_smcf_ObjMap_vdomain
  and inv_cf_ObjMap_app = smcf.inv_smcf_ObjMap_app
  and inv_cf_ObjMap_vrange = smcf.inv_smcf_ObjMap_vrange
  and inv_cf_ArrMap_v11 = smcf.inv_smcf_ArrMap_v11
  and inv_cf_ArrMap_vdomain = smcf.inv_smcf_ArrMap_vdomain
  and inv_cf_ArrMap_app = smcf.inv_smcf_ArrMap_app
  and inv_cf_ArrMap_vrange = smcf.inv_smcf_ArrMap_vrange
  and iso_cf_ObjMap_inv_cf_ObjMap_app =
    smcf.iso_smcf_ObjMap_inv_smcf_ObjMap_app
  and iso_cf_ArrMap_inv_cf_ArrMap_app = 
    smcf.iso_smcf_ArrMap_inv_smcf_ArrMap_app
  and iso_cf_HomDom_is_arr_conv = smcf.iso_smcf_HomDom_is_arr_conv
  and iso_cf_HomCod_is_arr_conv = smcf.iso_smcf_HomCod_is_arr_conv

end



subsectionβ€ΉAn isomorphism of categories is an isomorphism in the category β€ΉCATβ€Ίβ€Ί

lemma is_arr_isomorphism_is_iso_functor:
  ―‹See Chapter I-3 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "π”Š : 𝔅 ↦↦CΞ± 𝔄"
    and "π”Š ∘CF 𝔉 = cf_id 𝔄"
    and "𝔉 ∘CF π”Š = cf_id 𝔅"
  shows "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
proof-
  interpret 𝔉: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 𝔄 π”Š by (rule assms(2))
  show ?thesis
  proof(rule is_iso_functorI)
    have π”Šπ”‰π”„: "cf_smcf π”Š ∘SMCF cf_smcf 𝔉 = smcf_id (cat_smc 𝔄)"
      by (simp add: assms(3) cf_smcf_cf_id cf_smcf_smcf_comp)
    have π”‰π”Šπ”…: "cf_smcf 𝔉 ∘SMCF cf_smcf π”Š = smcf_id (cat_smc 𝔅)"
      by (simp add: assms(4) cf_smcf_cf_id cf_smcf_smcf_comp)
    from 𝔉.cf_is_semifunctor π”Š.cf_is_semifunctor π”Šπ”‰π”„ π”‰π”Šπ”… show 
      "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.isoΞ± cat_smc 𝔅" 
      by (rule is_arr_isomorphism_is_iso_semifunctor)
  qed (auto simp: cat_cs_intros)
qed

lemma is_iso_functor_is_arr_isomorphism:
  assumes "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  shows [cf_cs_intros]: "inv_cf 𝔉 : 𝔅 ↦↦C.isoΞ± 𝔄"
    and "inv_cf 𝔉 ∘CF 𝔉 = cf_id 𝔄"
    and "𝔉 ∘CF inv_cf 𝔉 = cf_id 𝔅"
proof-

  let ?π”Š = "inv_cf 𝔉"

  interpret is_iso_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(1))

  show π”Š: "?π”Š : 𝔅 ↦↦C.isoΞ± 𝔄"
  proof(intro is_iso_functorI is_functorI, unfold inv_dghm_components)
    show "vfsequence ?π”Š" by (simp add: inv_dghm_def)
    show "vcard ?π”Š = 4β„•"
      unfolding inv_dghm_def by (simp add: nat_omega_simps)
    show "cf_smcf ?π”Š : cat_smc 𝔅 ↦↦SMCΞ± cat_smc 𝔄"
      by 
        (
          metis 
            dghm_inv_semifunctor 
            iso_cf_is_iso_semifunctor 
            is_iso_semifunctor_def 
            is_iso_semifunctor_is_arr_isomorphism(1)
        ) 
    show "cf_smcf ?π”Š : cat_smc 𝔅 ↦↦SMC.isoΞ± cat_smc 𝔄"
      by 
        (
          metis 
            dghm_inv_semifunctor 
            iso_cf_is_iso_semifunctor 
            is_iso_semifunctor_is_arr_isomorphism(1)
        )
    fix c assume prems: "c ∈∘ 𝔅⦇Obj⦈"
    from prems show "(𝔉⦇ArrMap⦈)Β―βˆ˜β¦‡π”…β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔄⦇CIdβ¦ˆβ¦‡(𝔉⦇ObjMap⦈)Β―βˆ˜β¦‡c⦈⦈"
      by (intro v11.v11_vconverse_app)
        (
           cs_concl 
            cs_intro: cat_cs_intros V_cs_intros
            cs_simp: V_cs_simps cat_cs_simps
         )+
  qed (simp_all add: cat_cs_simps cat_cs_intros)

  show "?π”Š ∘CF 𝔉 = cf_id 𝔄"
  proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
    from π”Š is_functor_axioms show "?π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± 𝔄" 
      by (blast intro: cat_cs_intros)
  qed 
    (
      simp_all add: 
        HomDom.cat_cf_id_is_functor
        ObjMap.v11_vcomp_vconverse 
        ArrMap.v11_vcomp_vconverse 
        dghm_id_components
    )

  show "𝔉 ∘CF ?π”Š = cf_id 𝔅"
  proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
    from π”Š is_functor_axioms show "𝔉 ∘CF ?π”Š : 𝔅 ↦↦CΞ± 𝔅" 
      by (blast intro: cat_cs_intros)
    show "cf_id 𝔅 : 𝔅 ↦↦CΞ± 𝔅" by (simp add: HomCod.cat_cf_id_is_functor)
  qed 
    (
      simp_all add:
        ObjMap.v11_vcomp_vconverse' 
        ArrMap.v11_vcomp_vconverse' 
        dghm_id_components
    )

qed


subsubsectionβ€ΉAn identity functor is an isomorphism of categoriesβ€Ί

lemma (in category) cat_cf_id_is_iso_functor: "cf_id β„­ : β„­ ↦↦C.isoΞ± β„­"
  by (rule is_iso_functorI, unfold slicing_commute[symmetric])
    (
      simp_all add: 
        cat_cf_id_is_functor
        semicategory.smc_smcf_id_is_iso_semifunctor
        cat_semicategory
    )



subsectionβ€ΉIsomorphic categoriesβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).β€Ί

locale iso_category = L: category Ξ± 𝔄 + R: category Ξ± 𝔅 for Ξ± 𝔄 𝔅 +
  assumes iso_cat_is_iso_functor: "βˆƒπ”‰. 𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"

notation iso_category (infixl "β‰ˆCΔ±" 50)


textβ€ΉRules.β€Ί

lemma iso_categoryI:
  assumes "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅" 
  shows "𝔄 β‰ˆCΞ± 𝔅"
  using assms unfolding iso_category_def iso_category_axioms_def by auto

lemma iso_categoryD[dest]:
  assumes "𝔄 β‰ˆCΞ± 𝔅" 
  shows "βˆƒπ”‰. 𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅" 
  using assms unfolding iso_category_def iso_category_axioms_def by simp_all

lemma iso_categoryE[elim]:
  assumes "𝔄 β‰ˆCΞ± 𝔅" 
  obtains 𝔉 where "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  using assms by auto


textβ€ΉIsomorphic categories are isomorphic semicategories.β€Ί

lemma (in iso_category) iso_cat_iso_semicategory: 
  "cat_smc 𝔄 β‰ˆSMCΞ± cat_smc 𝔅"
  using iso_cat_is_iso_functor 
  by (auto intro: slicing_intros iso_semicategoryI)


subsubsectionβ€ΉA category isomorphism is an equivalence relationβ€Ί

lemma iso_category_refl: 
  assumes "category Ξ± 𝔄" 
  shows "𝔄 β‰ˆCΞ± 𝔄"
proof(rule iso_categoryI[of _ _ _ β€Ήcf_id 𝔄›])
  interpret category Ξ± 𝔄 by (rule assms)
  show "cf_id 𝔄 : 𝔄 ↦↦C.isoΞ± 𝔄" by (simp add: cat_cf_id_is_iso_functor)
qed                                        

lemma iso_category_sym[sym]:
  assumes "𝔄 β‰ˆCΞ± 𝔅" 
  shows "𝔅 β‰ˆCΞ± 𝔄"
proof-
  interpret iso_category Ξ± 𝔄 𝔅 by (rule assms)
  from iso_cat_is_iso_functor obtain 𝔉 where "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅" by clarsimp
  from is_iso_functor_is_arr_isomorphism(1)[OF this] show ?thesis 
    by (auto intro: iso_categoryI)
qed

lemma iso_category_trans[trans]:
  assumes "𝔄 β‰ˆCΞ± 𝔅" and "𝔅 β‰ˆCΞ± β„­" 
  shows "𝔄 β‰ˆCΞ± β„­"
proof-
  interpret L: iso_category Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret R: iso_category Ξ± 𝔅 β„­ by (rule assms(2))
  from L.iso_cat_is_iso_functor R.iso_cat_is_iso_functor show ?thesis 
    by (auto intro: iso_categoryI is_iso_functorI cf_comp_is_iso_functor)
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Small_Functor

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉSmallness for functorsβ€Ί
theory CZH_ECAT_Small_Functor
  imports 
    CZH_Foundations.CZH_SMC_Small_Semifunctor
    CZH_ECAT_Functor
    CZH_ECAT_Small_Category
begin



subsectionβ€ΉFunctor with tiny mapsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale is_tm_functor = is_functor Ξ± 𝔄 𝔅 𝔉  for Ξ± 𝔄 𝔅 𝔉 +
  assumes tm_cf_is_semifunctor[slicing_intros]: 
    "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.tmΞ± cat_smc 𝔅" 

syntax "_is_tm_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool" 
  (β€Ή(_ :/ _ ↦↦C.tmΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅" β‡Œ "CONST is_tm_functor Ξ± 𝔄 𝔅 𝔉"

abbreviation (input) is_cn_tm_functor :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  where "is_cn_tm_functor Ξ± 𝔄 𝔅 𝔉 ≑ 𝔉 : op_dg 𝔄 ↦↦C.tmΞ± 𝔅"

syntax "_is_cn_tm_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool" 
  (β€Ή(_ :/ _ C.tm↦↦ı _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 C.tm↦↦α 𝔅" ⇀ "CONST is_cn_tm_functor Ξ± 𝔄 𝔅 𝔉"

abbreviation all_tm_cfs :: "V β‡’ V"
  where "all_tm_cfs Ξ± ≑ set {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅}"

abbreviation small_tm_cfs :: "V β‡’ V β‡’ V β‡’ V"
  where "small_tm_cfs Ξ± 𝔄 𝔅 ≑ set {𝔉. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅}"

lemma (in is_tm_functor) tm_cf_is_semifunctor':
  assumes "Ξ±' = Ξ±"
    and "𝔄' = cat_smc 𝔄"
    and "𝔅' = cat_smc 𝔅"
  shows "cf_smcf 𝔉 : 𝔄' ↦↦SMC.tmΞ±' 𝔅'"
  unfolding assms by (rule tm_cf_is_semifunctor)

lemmas [slicing_intros] = is_tm_functor.tm_cf_is_semifunctor'


textβ€ΉRules.β€Ί

lemma (in is_tm_functor) is_tm_functor_axioms'[cat_small_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔉 : 𝔄' ↦↦C.tmΞ±' 𝔅'"
  unfolding assms by (rule is_tm_functor_axioms)

mk_ide rf is_tm_functor_def[unfolded is_tm_functor_axioms_def]
  |intro is_tm_functorI|
  |dest is_tm_functorD[dest]|
  |elim is_tm_functorE[elim]|

lemmas [cat_small_cs_intros] = is_tm_functorD(1)


textβ€ΉSlicing.β€Ί

context is_tm_functor
begin

interpretation smcf: is_tm_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
  by (rule tm_cf_is_semifunctor)

lemmas_with [unfolded slicing_simps]:
  tm_cf_ObjMap_in_Vset[cat_cs_intros] = smcf.tm_smcf_ObjMap_in_Vset
  and tm_cf_ArrMap_in_Vset[cat_cs_intros] = smcf.tm_smcf_ArrMap_in_Vset

end

sublocale is_tm_functor βŠ† HomDom: tiny_category Ξ± 𝔄
proof(rule tiny_categoryI')
  show "𝔄⦇Obj⦈ ∈∘ Vset Ξ±"
    by (rule vdomain_in_VsetI[OF tm_cf_ObjMap_in_Vset, unfolded cat_cs_simps])
  show "𝔄⦇Arr⦈ ∈∘ Vset Ξ±"
    by (rule vdomain_in_VsetI[OF tm_cf_ArrMap_in_Vset, unfolded cat_cs_simps])
qed (simp add: cat_cs_intros)


textβ€ΉFurther rules.β€Ί

lemma is_tm_functorI':
  assumes [simp]: "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and [simp]: "𝔉⦇ObjMap⦈ ∈∘ Vset Ξ±"
    and [simp]: "𝔉⦇ArrMap⦈ ∈∘ Vset Ξ±"
  shows "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
proof(intro is_tm_functorI)
  interpret is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(1))
  show "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.tmΞ± cat_smc 𝔅"
    by (intro is_tm_semifunctorI', unfold slicing_simps) 
      (auto simp: slicing_intros)
qed simp_all

lemma is_tm_functorD':
  assumes "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔉⦇ObjMap⦈ ∈∘ Vset Ξ±"
    and "𝔉⦇ArrMap⦈ ∈∘ Vset Ξ±"
proof-
  interpret is_tm_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(1))    
  show "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔉⦇ObjMap⦈ ∈∘ Vset Ξ±"
    and "𝔉⦇ArrMap⦈ ∈∘ Vset Ξ±"
    by (auto intro: cat_cs_intros)
qed

lemmas [cat_small_cs_intros] = is_tm_functorD'(1)

lemma is_tm_functorE':
  assumes "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔉⦇ObjMap⦈ ∈∘ Vset Ξ±"
    and "𝔉⦇ArrMap⦈ ∈∘ Vset Ξ±"
  using is_tm_functorD'[OF assms] by simp


textβ€ΉSize.β€Ί

lemma small_all_tm_cfs[simp]: "small {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅}"
proof(rule down)
  show 
    "{𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅} βŠ†
      elts (set {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅})"
  proof
    (
      simp only: elts_of_set small_all_cfs if_True, 
      rule subsetI, 
      unfold mem_Collect_eq
    )
    fix 𝔉 assume "βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    then obtain 𝔄 𝔅 where "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅" by clarsimp
    then interpret is_tm_functor Ξ± 𝔄 𝔅 𝔉 .
    show "βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅" by (blast intro: is_functor_axioms')
  qed
qed


subsubsectionβ€ΉOpposite functor with tiny mapsβ€Ί

lemma (in is_tm_functor) is_tm_functor_op: 
  "op_cf 𝔉 : op_cat 𝔄 ↦↦C.tmΞ± op_cat 𝔅"
  by (intro is_tm_functorI', unfold cat_op_simps)
    (cs_concl cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_tm_functor) is_tm_functor_op'[cat_op_intros]:  
  assumes "𝔄' = op_cat 𝔄" and "𝔅' = op_cat 𝔅" and "Ξ±' = Ξ±"
  shows "op_cf 𝔉 : 𝔄' ↦↦C.tmΞ±' 𝔅'"
  unfolding assms by (rule is_tm_functor_op)

lemmas is_tm_functor_op[cat_op_intros] = is_tm_functor.is_tm_functor_op'


subsubsectionβ€ΉComposition of functors with tiny mapsβ€Ί

lemma cf_comp_is_tm_functor[cat_small_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦C.tmΞ± β„­" and "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 ↦↦C.tmΞ± β„­"
proof(rule is_tm_functorI)
  interpret 𝔉: is_tm_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  interpret π”Š: is_tm_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1))
  from 𝔉.tm_cf_is_semifunctor π”Š.tm_cf_is_semifunctor show 
    "cf_smcf (π”Š ∘CF 𝔉) : cat_smc 𝔄 ↦↦SMC.tmΞ± cat_smc β„­"   
    by (auto simp: smc_small_cs_intros slicing_commute[symmetric])
  show "π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­" by (auto intro: cat_cs_intros)
qed


subsubsectionβ€ΉFinite categories and functors with tiny mapsβ€Ί

lemma (in is_functor) cf_is_tm_functor_if_HomDom_finite_category:
  assumes "finite_category Ξ± 𝔄"
  shows "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
proof(intro is_tm_functorI)
  interpret 𝔄: finite_category Ξ± 𝔄 by (rule assms(1))
  show "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.tmΞ± cat_smc 𝔅"
    by 
      (
        rule 
          is_semifunctor.smcf_is_tm_semifunctor_if_HomDom_finite_semicategory[
            OF cf_is_semifunctor 𝔄.fin_cat_finite_semicategory
            ]
      )
qed (auto intro: cat_cs_intros)


subsubsectionβ€ΉConstant functor with tiny mapsβ€Ί

lemma cf_const_is_tm_functor: 
  assumes "tiny_category Ξ± β„­" and "category Ξ± 𝔇" and "a ∈∘ 𝔇⦇Obj⦈"
  shows "cf_const β„­ 𝔇 a : β„­ ↦↦C.tmΞ± 𝔇"
proof(intro is_tm_functorI)
  from assms show "cf_smcf (cf_const β„­ 𝔇 a) : cat_smc β„­ ↦↦SMC.tmΞ± cat_smc 𝔇"
    by 
      (
        cs_concl 
          cs_simp: slicing_commute[symmetric] slicing_simps cat_cs_simps 
          cs_intro: slicing_intros cat_cs_intros smc_small_cs_intros
      )+
  from assms show "cf_const β„­ 𝔇 a : β„­ ↦↦CΞ± 𝔇"
    by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
qed

lemma cf_const_is_tm_functor'[cat_small_cs_intros]:
  assumes "tiny_category Ξ± β„­"
    and "category Ξ± 𝔇" 
    and "a ∈∘ 𝔇⦇Obj⦈"
    and "β„­' = β„­"
    and "𝔇' = 𝔇"
  shows "cf_const β„­ 𝔇 a : β„­' ↦↦C.tmΞ± 𝔇'"
  using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_tm_functor)



subsectionβ€ΉTiny functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale is_tiny_functor = is_functor Ξ± 𝔄 𝔅 𝔉 for Ξ± 𝔄 𝔅 𝔉 +
  assumes tiny_cf_is_tiny_semifunctor[slicing_intros]: 
    "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.tinyΞ± cat_smc 𝔅" 

syntax "_is_tiny_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦↦C.tinyΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅" β‡Œ "CONST is_tiny_functor Ξ± 𝔄 𝔅 𝔉"

abbreviation (input) is_cn_tiny_cf :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  where "is_cn_tiny_cf Ξ± 𝔄 𝔅 𝔉 ≑ 𝔉 : op_cat 𝔄 ↦↦C.tinyΞ± 𝔅"

syntax "_is_cn_tiny_cf" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ C.tiny↦↦ı _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 C.tiny↦↦α 𝔅" ⇀ "CONST is_cn_cf Ξ± 𝔄 𝔅 𝔉"

abbreviation all_tiny_cfs :: "V β‡’ V"
  where "all_tiny_cfs Ξ± ≑ set {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅}"

abbreviation tiny_cfs :: "V β‡’ V β‡’ V β‡’ V"
  where "tiny_cfs Ξ± 𝔄 𝔅 ≑ set {𝔉. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅}"

lemmas [slicing_intros] = is_tiny_functor.tiny_cf_is_tiny_semifunctor


textβ€ΉRules.β€Ί

lemma (in is_tiny_functor) is_tiny_functor_axioms'[cat_small_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔉 : 𝔄' ↦↦C.tinyΞ±' 𝔅'"
  unfolding assms by (rule is_tiny_functor_axioms)

mk_ide rf is_tiny_functor_def[unfolded is_tiny_functor_axioms_def]
  |intro is_tiny_functorI|
  |dest is_tiny_functorD[dest]|
  |elim is_tiny_functorE[elim]|

lemmas [cat_small_cs_intros] = is_tiny_functorD(1)


textβ€ΉElementary properties.β€Ί

sublocale is_tiny_functor βŠ† HomDom: tiny_category Ξ± 𝔄
proof(intro tiny_categoryI')
  interpret smcf: is_tiny_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
    by (rule tiny_cf_is_tiny_semifunctor)
  show "𝔄⦇Obj⦈ ∈∘ Vset Ξ±"
    by (rule smcf.HomDom.tiny_smc_Obj_in_Vset[unfolded slicing_simps])    
  show "𝔄⦇Arr⦈ ∈∘ Vset Ξ±"
    by (rule smcf.HomDom.tiny_smc_Arr_in_Vset[unfolded slicing_simps])    
qed (auto simp: cat_cs_intros)

sublocale is_tiny_functor βŠ† HomCod: tiny_category Ξ± 𝔅
proof(intro tiny_categoryI')
  interpret smcf: is_tiny_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
    by (rule tiny_cf_is_tiny_semifunctor)
  show "𝔅⦇Obj⦈ ∈∘ Vset Ξ±"
    by (rule smcf.HomCod.tiny_smc_Obj_in_Vset[unfolded slicing_simps])    
  show "𝔅⦇Arr⦈ ∈∘ Vset Ξ±"
    by (rule smcf.HomCod.tiny_smc_Arr_in_Vset[unfolded slicing_simps])    
qed (auto simp: cat_cs_intros)

sublocale is_tiny_functor βŠ† is_tm_functor
proof(intro is_tm_functorI')
  interpret smcf: is_tiny_semifunctor Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉›
    by (rule tiny_cf_is_tiny_semifunctor)
  note Vset[unfolded slicing_simps] = 
    smcf.tm_smcf_ObjMap_in_Vset
    smcf.tm_smcf_ArrMap_in_Vset
  show "𝔉⦇ObjMap⦈ ∈∘ Vset Ξ±" "𝔉⦇ArrMap⦈ ∈∘ Vset Ξ±" by (intro Vset)+
qed (auto simp: cat_cs_intros)


textβ€ΉFurther rules.β€Ί

lemma is_tiny_functorI':
  assumes [simp]: "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "tiny_category Ξ± 𝔄"
    and "tiny_category Ξ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
proof(intro is_tiny_functorI)
  interpret 𝔉: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(1))
  interpret 𝔄: tiny_category Ξ± 𝔄 by (rule assms(2))
  interpret 𝔅: tiny_category Ξ± 𝔅 by (rule assms(3))
  show "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.tinyΞ± cat_smc 𝔅"
    by (intro is_tiny_semifunctorI') (auto intro: slicing_intros)
qed (rule assms(1))

lemma is_tiny_functorD':
  assumes "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "tiny_category Ξ± 𝔄"
    and "tiny_category Ξ± 𝔅"
proof-
  interpret is_tiny_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(1))
  show "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and "tiny_category Ξ± 𝔄" and "tiny_category Ξ± 𝔅"
    by (auto intro: cat_small_cs_intros)
qed

lemmas [cat_small_cs_intros] = is_tiny_functorD'(2,3)

lemma is_tiny_functorE':
  assumes "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "tiny_category Ξ± 𝔄"
    and "tiny_category Ξ± 𝔅"
  using is_tiny_functorD'[OF assms] by auto

lemma is_tiny_functor_iff:
  "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅 ⟷ 
    (𝔉 : 𝔄 ↦↦CΞ± 𝔅 ∧ tiny_category Ξ± 𝔄 ∧ tiny_category Ξ± 𝔅)"
  by (auto intro: is_tiny_functorI' dest: is_tiny_functorD'(2,3))


textβ€ΉSize.β€Ί

lemma (in is_tiny_functor) tiny_cf_in_Vset: "𝔉 ∈∘ Vset Ξ±"
proof-
  note [cat_cs_intros] = 
    tm_cf_ObjMap_in_Vset 
    tm_cf_ArrMap_in_Vset
    HomDom.tiny_cat_in_Vset 
    HomCod.tiny_cat_in_Vset 
  show ?thesis
    by (subst cf_def) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed

lemma small_all_tiny_cfs[simp]: "small {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅}"
proof(rule down)
  show 
    "{𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅} βŠ† 
      elts (set {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅})"
  proof
    (
      simp only: elts_of_set small_all_cfs if_True, 
      rule subsetI, 
      unfold mem_Collect_eq
    )
    fix 𝔉 assume "βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    then obtain 𝔄 𝔅 where "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅" by clarsimp
    then interpret is_tiny_functor Ξ± 𝔄 𝔅 𝔉 by simp
    show "βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦CΞ± 𝔅" by (meson is_functor_axioms)
  qed
qed

lemma small_tiny_cfs[simp]: "small {𝔉. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅}"
  by (rule down[of _ β€Ήset {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅}β€Ί]) auto

lemma all_tiny_cfs_vsubset_Vset[simp]: 
  "set {𝔉. βˆƒπ”„ 𝔅. 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅} βŠ†βˆ˜ Vset Ξ±"
proof(rule vsubsetI) 
  fix 𝔉 assume "𝔉 ∈∘ all_tiny_cfs Ξ±"
  then obtain 𝔄 𝔅 where "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅" by clarsimp
  then show "𝔉 ∈∘ Vset Ξ±" by (auto simp: is_tiny_functor.tiny_cf_in_Vset)
qed

lemma (in is_functor) cf_is_tiny_functor_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "𝔉 : 𝔄 ↦↦C.tinyΞ² 𝔅"
proof(intro is_tiny_functorI)
  show "cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMC.tinyΞ² cat_smc 𝔅"
    by 
      (
        rule is_semifunctor.smcf_is_tiny_semifunctor_if_ge_Limit, 
        rule cf_is_semifunctor; 
        intro assms
      )
qed (simp add: cf_is_functor_if_ge_Limit assms)


subsubsectionβ€ΉOpposite tiny semifunctorβ€Ί

lemma (in is_tiny_functor) is_tiny_functor_op: 
  "op_cf 𝔉 : op_cat 𝔄 ↦↦C.tinyΞ± op_cat 𝔅"
  by (intro is_tiny_functorI') 
    (cs_concl cs_intro: cat_op_intros cat_small_cs_intros)+

lemma (in is_tiny_functor) is_tiny_functor_op'[cat_op_intros]:  
  assumes "𝔄' = op_cat 𝔄" and "𝔅' = op_cat 𝔅" and "Ξ±' = Ξ±"
  shows "op_cf 𝔉 : 𝔄' ↦↦C.tinyΞ±' 𝔅'"
  unfolding assms by (rule is_tiny_functor_op)

lemmas is_tiny_functor_op[cat_op_intros] = 
  is_tiny_functor.is_tiny_functor_op'


subsubsectionβ€ΉComposition of tiny functorsβ€Ί

lemma cf_comp_is_tiny_functor[cat_small_cs_intros]:
  assumes "π”Š : 𝔅 ↦↦C.tinyΞ± β„­" and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 ↦↦C.tinyΞ± β„­"
proof-
  interpret 𝔉: is_tiny_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  interpret π”Š: is_tiny_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1))
  show ?thesis by (rule is_tiny_functorI') (auto intro: cat_small_cs_intros)
qed


subsubsectionβ€ΉTiny constant functorβ€Ί

lemma cf_const_is_tiny_functor:
  assumes "tiny_category Ξ± β„­" and "tiny_category Ξ± 𝔇" and "a ∈∘ 𝔇⦇Obj⦈"
  shows "cf_const β„­ 𝔇 a : β„­ ↦↦C.tinyΞ± 𝔇"
proof(intro is_tiny_functorI')
  from assms show "cf_const β„­ 𝔇 a : β„­ ↦↦CΞ± 𝔇"
    by (cs_concl cs_intro: cat_small_cs_intros)
qed (auto simp: assms(1,2))

lemma cf_const_is_tiny_functor':
  assumes "tiny_category Ξ± β„­"
    and "tiny_category Ξ± 𝔇" 
    and "a ∈∘ 𝔇⦇Obj⦈"
    and "β„­' = β„­"
    and "𝔇' = 𝔇"
  shows "cf_const β„­ 𝔇 a : β„­' ↦↦C.tinyΞ± 𝔇'"
  using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_tiny_functor)

lemmas [cat_small_cs_intros] = cf_const_is_tiny_functor'

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_NTCF

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉNatural transformationβ€Ί
theory CZH_ECAT_NTCF
  imports 
    CZH_Foundations.CZH_SMC_NTSMCF
    CZH_ECAT_Functor
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems ntcf_cs_simps
named_theorems ntcf_cs_intros

lemmas [cat_cs_simps] = dg_shared_cs_simps
lemmas [cat_cs_intros] = dg_shared_cs_intros


subsubsectionβ€ΉSlicingβ€Ί

definition ntcf_ntsmcf :: "V β‡’ V"
  where "ntcf_ntsmcf 𝔑 =
    [
      𝔑⦇NTMap⦈,
      cf_smcf (𝔑⦇NTDom⦈),
      cf_smcf (𝔑⦇NTCod⦈),
      cat_smc (𝔑⦇NTDGDom⦈),
      cat_smc (𝔑⦇NTDGCod⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_ntsmcf_components:
  shows [slicing_simps]: "ntcf_ntsmcf 𝔑⦇NTMap⦈ = 𝔑⦇NTMap⦈"
    and [slicing_commute]: "ntcf_ntsmcf 𝔑⦇NTDom⦈ = cf_smcf (𝔑⦇NTDom⦈)"
    and [slicing_commute]: "ntcf_ntsmcf 𝔑⦇NTCod⦈ = cf_smcf (𝔑⦇NTCod⦈)"
    and [slicing_commute]: "ntcf_ntsmcf 𝔑⦇NTDGDom⦈ = cat_smc (𝔑⦇NTDGDom⦈)"
    and [slicing_commute]: "ntcf_ntsmcf 𝔑⦇NTDGCod⦈ = cat_smc (𝔑⦇NTDGCod⦈)"
  unfolding ntcf_ntsmcf_def nt_field_simps by (auto simp: nat_omega_simps)



subsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The definition of a natural transformation that is used in this work is
is similar to the definition that can be found in Chapter I-4 in 
\cite{mac_lane_categories_2010}.
β€Ί

locale is_ntcf = 
  𝒡 Ξ± + 
  vfsequence 𝔑 + 
  NTDom: is_functor Ξ± 𝔄 𝔅 𝔉 + 
  NTCod: is_functor Ξ± 𝔄 𝔅 π”Š
  for Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 +
  assumes ntcf_length[cat_cs_simps]: "vcard 𝔑 = 5β„•"  
    and ntcf_is_ntsmcf[slicing_intros]: "ntcf_ntsmcf 𝔑 :
      cf_smcf 𝔉 ↦SMCF cf_smcf π”Š : cat_smc 𝔄 ↦↦SMCΞ± cat_smc 𝔅"
    and ntcf_NTDom[cat_cs_simps]: "𝔑⦇NTDom⦈ = 𝔉"
    and ntcf_NTCod[cat_cs_simps]: "𝔑⦇NTCod⦈ = π”Š"
    and ntcf_NTDGDom[cat_cs_simps]: "𝔑⦇NTDGDom⦈ = 𝔄"
    and ntcf_NTDGCod[cat_cs_simps]: "𝔑⦇NTDGCod⦈ = 𝔅"

syntax "_is_ntcf" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦CF _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" β‡Œ "CONST is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑"

abbreviation all_ntcfs :: "V β‡’ V"
  where "all_ntcfs Ξ± ≑ set {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"

abbreviation ntcfs :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcfs Ξ± 𝔄 𝔅 ≑ set {𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"

abbreviation these_ntcfs :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "these_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š ≑ set {𝔑. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"

lemmas [cat_cs_simps] = 
  is_ntcf.ntcf_length
  is_ntcf.ntcf_NTDom
  is_ntcf.ntcf_NTCod
  is_ntcf.ntcf_NTDGDom
  is_ntcf.ntcf_NTDGCod

lemma (in is_ntcf) ntcf_is_ntsmcf':
  assumes "𝔉' = cf_smcf 𝔉"
    and "π”Š' = cf_smcf π”Š"
    and "𝔄' = cat_smc 𝔄"
    and "𝔅' = cat_smc 𝔅"
  shows "ntcf_ntsmcf 𝔑 : 𝔉' ↦SMCF π”Š' : 𝔄' ↦↦SMCΞ± 𝔅'"
  unfolding assms(1-4) by (rule ntcf_is_ntsmcf)

lemmas [slicing_intros] = is_ntcf.ntcf_is_ntsmcf'


textβ€ΉRules.β€Ί

lemma (in is_ntcf) is_ntcf_axioms'[cat_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅" and "𝔉' = 𝔉" and "π”Š' = π”Š"
  shows "𝔑 : 𝔉' ↦CF π”Š' : 𝔄' ↦↦CΞ±' 𝔅'"
  unfolding assms by (rule is_ntcf_axioms)

mk_ide rf is_ntcf_def[unfolded is_ntcf_axioms_def]
  |intro is_ntcfI|
  |dest is_ntcfD[dest]|
  |elim is_ntcfE[elim]|

lemmas [cat_cs_intros] = 
  is_ntcfD(3,4)

lemma is_ntcfI':
  assumes "𝒡 Ξ±"
    and "vfsequence 𝔑"
    and "vcard 𝔑 = 5β„•"
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑⦇NTDom⦈ = 𝔉"
    and "𝔑⦇NTCod⦈ = π”Š"
    and "𝔑⦇NTDGDom⦈ = 𝔄"
    and "𝔑⦇NTDGCod⦈ = 𝔅"
    and "vsv (𝔑⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (𝔑⦇NTMap⦈) = 𝔄⦇Obj⦈"
    and "β‹€a. a ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
    and "β‹€a b f. f : a ↦𝔄 b ⟹
      𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
  shows "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  by (intro is_ntcfI is_ntsmcfI', unfold ntcf_ntsmcf_components slicing_simps)
    (
      simp_all add: 
        assms nat_omega_simps 
        ntcf_ntsmcf_def  
        is_functorD(6)[OF assms(4)] 
        is_functorD(6)[OF assms(5)]
    )

lemma is_ntcfD':
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝒡 Ξ±"
    and "vfsequence 𝔑"
    and "vcard 𝔑 = 5β„•"
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑⦇NTDom⦈ = 𝔉"
    and "𝔑⦇NTCod⦈ = π”Š"
    and "𝔑⦇NTDGDom⦈ = 𝔄"
    and "𝔑⦇NTDGCod⦈ = 𝔅"
    and "vsv (𝔑⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (𝔑⦇NTMap⦈) = 𝔄⦇Obj⦈"
    and "β‹€a. a ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
    and "β‹€a b f. f : a ↦𝔄 b ⟹
      𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
  by 
    (
      simp_all add: 
        is_ntcfD(2-10)[OF assms] 
        is_ntsmcfD'[OF is_ntcfD(6)[OF assms], unfolded slicing_simps]
    )

lemma is_ntcfE':
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  obtains "𝒡 Ξ±"
    and "vfsequence 𝔑"
    and "vcard 𝔑 = 5β„•"
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑⦇NTDom⦈ = 𝔉"
    and "𝔑⦇NTCod⦈ = π”Š"
    and "𝔑⦇NTDGDom⦈ = 𝔄"
    and "𝔑⦇NTDGCod⦈ = 𝔅"
    and "vsv (𝔑⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (𝔑⦇NTMap⦈) = 𝔄⦇Obj⦈"
    and "β‹€a. a ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
    and "β‹€a b f. f : a ↦𝔄 b ⟹
      𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
  using assms by (simp add: is_ntcfD')


textβ€ΉSlicing.β€Ί

context is_ntcf
begin

interpretation ntsmcf: 
  is_ntsmcf Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉› β€Ήcf_smcf π”Šβ€Ί β€Ήntcf_ntsmcf 𝔑›
  by (rule ntcf_is_ntsmcf)

lemmas_with [unfolded slicing_simps]:
  ntcf_NTMap_vsv = ntsmcf.ntsmcf_NTMap_vsv
  and ntcf_NTMap_vdomain[cat_cs_simps] = ntsmcf.ntsmcf_NTMap_vdomain
  and ntcf_NTMap_is_arr = ntsmcf.ntsmcf_NTMap_is_arr
  and ntcf_NTMap_is_arr'[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_is_arr'

sublocale NTMap: vsv ‹𝔑⦇NTMapβ¦ˆβ€Ί
  rewrites "π’Ÿβˆ˜ (𝔑⦇NTMap⦈) = 𝔄⦇Obj⦈"
  by (rule ntcf_NTMap_vsv) (simp add: cat_cs_simps)

lemmas_with [unfolded slicing_simps]:
  ntcf_NTMap_app_in_Arr[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_app_in_Arr
  and ntcf_NTMap_vrange_vifunion = ntsmcf.ntsmcf_NTMap_vrange_vifunion
  and ntcf_NTMap_vrange = ntsmcf.ntsmcf_NTMap_vrange
  and ntcf_NTMap_vsubset_Vset = ntsmcf.ntsmcf_NTMap_vsubset_Vset
  and ntcf_NTMap_in_Vset = ntsmcf.ntsmcf_NTMap_in_Vset
  and ntcf_is_ntsmcf_if_ge_Limit = ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit

lemmas_with [unfolded slicing_simps]:
  ntcf_Comp_commute[cat_cs_intros] = ntsmcf.ntsmcf_Comp_commute
  and ntcf_Comp_commute' = ntsmcf.ntsmcf_Comp_commute'
  and ntcf_Comp_commute'' = ntsmcf.ntsmcf_Comp_commute''

end

lemmas [cat_cs_simps] = is_ntcf.ntcf_NTMap_vdomain

lemmas [cat_cs_intros] = 
  is_ntcf.ntcf_NTMap_is_arr'
  ntsmcf_hcomp_NTMap_vsv


textβ€ΉElementary properties.β€Ί

lemma ntcf_eqI:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑' : 𝔉' ↦CF π”Š' : 𝔄' ↦↦CΞ± 𝔅'"
    and "𝔑⦇NTMap⦈ = 𝔑'⦇NTMap⦈"
    and "𝔉 = 𝔉'"
    and "π”Š = π”Š'"
    and "𝔄 = 𝔄'"
    and "𝔅 = 𝔅'"
  shows "𝔑 = 𝔑'"
proof-
  interpret L: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret R: is_ntcf Ξ± 𝔄' 𝔅' 𝔉' π”Š' 𝔑' by (rule assms(2))
  show ?thesis
  proof(rule vsv_eqI)
    have dom: "π’Ÿβˆ˜ 𝔑 = 5β„•" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
    show "π’Ÿβˆ˜ 𝔑 = π’Ÿβˆ˜ 𝔑'" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
    from assms(4-7) have sup: 
      "𝔑⦇NTDom⦈ = 𝔑'⦇NTDom⦈" "𝔑⦇NTCod⦈ = 𝔑'⦇NTCod⦈" 
      "𝔑⦇NTDGDom⦈ = 𝔑'⦇NTDGDom⦈" "𝔑⦇NTDGCod⦈ = 𝔑'⦇NTDGCod⦈" 
      by (simp_all add: cat_cs_simps)
    show "a ∈∘ π’Ÿβˆ˜ 𝔑 ⟹ 𝔑⦇a⦈ = 𝔑'⦇a⦈" for a
      by (unfold dom, elim_in_numeral, insert assms(3) sup) 
        (auto simp: nt_field_simps)
  qed auto
qed

lemma ntcf_ntsmcf_eqI:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑' : 𝔉' ↦CF π”Š' : 𝔄' ↦↦CΞ± 𝔅'"
    and "𝔉 = 𝔉'"
    and "π”Š = π”Š'"
    and "𝔄 = 𝔄'"
    and "𝔅 = 𝔅'"
    and "ntcf_ntsmcf 𝔑 = ntcf_ntsmcf 𝔑'"
  shows "𝔑 = 𝔑'"
proof(rule ntcf_eqI[of Ξ±])
  from assms(7) have "ntcf_ntsmcf 𝔑⦇NTMap⦈ = ntcf_ntsmcf 𝔑'⦇NTMap⦈" by simp
  then show "𝔑⦇NTMap⦈ = 𝔑'⦇NTMap⦈" unfolding slicing_simps by simp_all
  from assms(3-6) show "𝔉 = 𝔉'" "π”Š = π”Š'" "𝔄 = 𝔄'" "𝔅 = 𝔅'" by simp_all
qed (auto simp: assms(1,2))

lemma (in is_ntcf) ntcf_def:
  "𝔑 = [𝔑⦇NTMap⦈, 𝔑⦇NTDom⦈, 𝔑⦇NTCod⦈, 𝔑⦇NTDGDom⦈, 𝔑⦇NTDGCod⦈]∘"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ 𝔑 = 5β„•" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
  have dom_rhs:
    "π’Ÿβˆ˜ [𝔑⦇NTMap⦈, 𝔑⦇NTDGDom⦈, 𝔑⦇NTDGCod⦈, 𝔑⦇NTDom⦈, 𝔑⦇NTCod⦈]∘ = 5β„•"
    by (simp add: nat_omega_simps)
  then show 
    "π’Ÿβˆ˜ 𝔑 = π’Ÿβˆ˜ [𝔑⦇NTMap⦈, 𝔑⦇NTDom⦈, 𝔑⦇NTCod⦈, 𝔑⦇NTDGDom⦈, 𝔑⦇NTDGCod⦈]∘"
    unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
  show "a ∈∘ π’Ÿβˆ˜ 𝔑 ⟹
    𝔑⦇a⦈ = [𝔑⦇NTMap⦈, 𝔑⦇NTDom⦈, 𝔑⦇NTCod⦈, 𝔑⦇NTDGDom⦈, 𝔑⦇NTDGCod⦈]βˆ˜β¦‡a⦈" 
    for a
    by (unfold dom_lhs, elim_in_numeral, unfold nt_field_simps)
      (simp_all add: nat_omega_simps)
qed (auto simp: vsv_axioms)

lemma (in is_ntcf) ntcf_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"  
  shows "𝔑 ∈∘ Vset Ξ²"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  note [cat_cs_intros] = 
    ntcf_NTMap_in_Vset
    NTDom.cf_in_Vset
    NTCod.cf_in_Vset
    NTDom.HomDom.cat_in_Vset
    NTDom.HomCod.cat_in_Vset
  from assms(2) show ?thesis
    by (subst ntcf_def) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed

lemma (in is_ntcf) ntcf_is_ntcf_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ² 𝔅"
proof(intro is_ntcfI)
  show "ntcf_ntsmcf 𝔑 :
    cf_smcf 𝔉 ↦SMCF cf_smcf π”Š : cat_smc 𝔄 ↦↦SMCΞ² cat_smc 𝔅"
    by (rule is_ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit[OF ntcf_is_ntsmcf assms])
qed 
  (
    cs_concl 
      cs_simp: cat_cs_simps 
      cs_intro:
        V_cs_intros
        assms 
        NTDom.cf_is_functor_if_ge_Limit
        NTCod.cf_is_functor_if_ge_Limit
   )+

lemma small_all_ntcfs[simp]:
  "small {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"
proof(cases ‹𝒡 Ξ±β€Ί)
  case True
  from is_ntcf.ntcf_in_Vset show ?thesis
    by (intro down[of _ β€ΉVset (Ξ± + Ο‰)β€Ί])
      (auto simp: True 𝒡.𝒡_Limit_Ξ±Ο‰ 𝒡.𝒡_Ο‰_Ξ±Ο‰ 𝒡.intro 𝒡.𝒡_Ξ±_Ξ±Ο‰)
next
  case False
  then have "{𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅} = {}" by auto
  then show ?thesis by simp
qed

lemma small_ntcfs[simp]: "small {𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"
  by (rule down[of _ β€Ήset {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}β€Ί]) auto

lemma small_these_ntcfs[simp]: "small {𝔑. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"
  by (rule down[of _ β€Ήset {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}β€Ί]) auto


textβ€ΉFurther elementary results.β€Ί

lemma these_ntcfs_iff: (*not simp*) 
  "𝔑 ∈∘ these_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š ⟷ 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  by auto



subsectionβ€ΉOpposite natural transformationβ€Ί


textβ€ΉSee section 1.5 in \cite{bodo_categories_1970}.β€Ί

definition op_ntcf :: "V β‡’ V"
  where "op_ntcf 𝔑 = 
    [
      𝔑⦇NTMap⦈, 
      op_cf (𝔑⦇NTCod⦈), 
      op_cf (𝔑⦇NTDom⦈), 
      op_cat (𝔑⦇NTDGDom⦈), 
      op_cat (𝔑⦇NTDGCod⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma op_ntcf_components[cat_op_simps]:
  shows "op_ntcf 𝔑⦇NTMap⦈ = 𝔑⦇NTMap⦈"
    and "op_ntcf 𝔑⦇NTDom⦈ = op_cf (𝔑⦇NTCod⦈)"
    and "op_ntcf 𝔑⦇NTCod⦈ = op_cf (𝔑⦇NTDom⦈)"
    and "op_ntcf 𝔑⦇NTDGDom⦈ = op_cat (𝔑⦇NTDGDom⦈)"
    and "op_ntcf 𝔑⦇NTDGCod⦈ = op_cat (𝔑⦇NTDGCod⦈)"
  unfolding op_ntcf_def nt_field_simps by (auto simp: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma ntcf_ntsmcf_op_ntcf[slicing_commute]: 
  "op_ntsmcf (ntcf_ntsmcf 𝔑) = ntcf_ntsmcf (op_ntcf 𝔑)"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (op_ntsmcf (ntcf_ntsmcf 𝔑)) = 5β„•"
    unfolding op_ntsmcf_def by (auto simp: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (ntcf_ntsmcf (op_ntcf 𝔑)) = 5β„•"
    unfolding ntcf_ntsmcf_def by (auto simp: nat_omega_simps)
  show "π’Ÿβˆ˜ (op_ntsmcf (ntcf_ntsmcf 𝔑)) = π’Ÿβˆ˜ (ntcf_ntsmcf (op_ntcf 𝔑))"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (op_ntsmcf (ntcf_ntsmcf 𝔑)) ⟹ 
    op_ntsmcf (ntcf_ntsmcf 𝔑)⦇a⦈ = ntcf_ntsmcf (op_ntcf 𝔑)⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs,
        elim_in_numeral,
        unfold nt_field_simps ntcf_ntsmcf_def op_ntcf_def op_ntsmcf_def
      )
      (auto simp: nat_omega_simps slicing_commute[symmetric])
qed (auto simp: ntcf_ntsmcf_def op_ntsmcf_def)


textβ€ΉElementary properties.β€Ί

lemma op_ntcf_vsv[cat_op_intros]: "vsv (op_ntcf 𝔉)" 
  unfolding op_ntcf_def by auto


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in is_ntcf) is_ntcf_op: 
  "op_ntcf 𝔑 : op_cf π”Š ↦CF op_cf 𝔉 : op_cat 𝔄 ↦↦CΞ± op_cat 𝔅"
proof(rule is_ntcfI, unfold cat_op_simps)
  show "vfsequence (op_ntcf 𝔑)" by (simp add: op_ntcf_def)
  show "vcard (op_ntcf 𝔑) = 5β„•" by (simp add: op_ntcf_def nat_omega_simps)
qed
  (
    use is_ntcf_axioms in
    β€Ή
      cs_concl 
        cs_simp: cat_cs_simps slicing_commute[symmetric]
        cs_intro: cat_cs_intros cat_op_intros smc_op_intros slicing_intros
    β€Ί
  )+

lemma (in is_ntcf) is_ntcf_op'[cat_op_intros]:
  assumes "π”Š' = op_cf π”Š"
    and "𝔉' = op_cf 𝔉"
    and "𝔄' = op_cat 𝔄"
    and "𝔅' = op_cat 𝔅"
  shows "op_ntcf 𝔑 : π”Š' ↦CF 𝔉' : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms by (rule is_ntcf_op)

lemmas [cat_op_intros] = is_ntcf.is_ntcf_op'

lemma (in is_ntcf) ntcf_op_ntcf_op_ntcf[cat_op_simps]: 
  "op_ntcf (op_ntcf 𝔑) = 𝔑"
proof(rule ntcf_eqI[of Ξ± 𝔄 𝔅 𝔉 π”Š _ 𝔄 𝔅 𝔉 π”Š], unfold cat_op_simps)
  interpret op: 
    is_ntcf Ξ± β€Ήop_cat 𝔄› β€Ήop_cat 𝔅› β€Ήop_cf π”Šβ€Ί β€Ήop_cf 𝔉› β€Ήop_ntcf 𝔑›
    by (rule is_ntcf_op)
  from op.is_ntcf_op show 
    "op_ntcf (op_ntcf 𝔑) : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by (simp add: cat_op_simps)
qed (auto simp: cat_cs_intros)

lemmas ntcf_op_ntcf_op_ntcf[cat_op_simps] = 
  is_ntcf.ntcf_op_ntcf_op_ntcf

lemma eq_op_ntcf_iff[cat_op_simps]: 
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" and "𝔑' : 𝔉' ↦CF π”Š' : 𝔄' ↦↦CΞ± 𝔅'"
  shows "op_ntcf 𝔑 = op_ntcf 𝔑' ⟷ 𝔑 = 𝔑'"
proof
  interpret L: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret R: is_ntcf Ξ± 𝔄' 𝔅' 𝔉' π”Š' 𝔑' by (rule assms(2))
  assume prems: "op_ntcf 𝔑 = op_ntcf 𝔑'"
  show "𝔑 = 𝔑'"
  proof(rule ntcf_eqI[OF assms])
    from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf show 
      "𝔑⦇NTMap⦈ = 𝔑'⦇NTMap⦈"
      by metis+
    from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf 
    have "𝔑⦇NTDom⦈ = 𝔑'⦇NTDom⦈" 
      and "𝔑⦇NTCod⦈ = 𝔑'⦇NTCod⦈" 
      and "𝔑⦇NTDGDom⦈ = 𝔑'⦇NTDGDom⦈" 
      and "𝔑⦇NTDGCod⦈ = 𝔑'⦇NTDGCod⦈" 
      by metis+
    then show "𝔉 = 𝔉'" "π”Š = π”Š'" "𝔄 = 𝔄'" "𝔅 = 𝔅'" 
      by (auto simp: cat_cs_simps)
  qed
qed auto



subsectionβ€ΉVertical composition of natural transformationsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-4 in \cite{mac_lane_categories_2010}.β€Ί

abbreviation (input) ntcf_vcomp :: "V β‡’ V β‡’ V" (infixl β€Ήβˆ™NTCFβ€Ί 55)
  where "ntcf_vcomp ≑ ntsmcf_vcomp"

lemmas [cat_cs_simps] = ntsmcf_vcomp_components(2-5)


textβ€ΉSlicing.β€Ί

lemma ntcf_ntsmcf_ntcf_vcomp[slicing_commute]: 
  "ntcf_ntsmcf 𝔐 βˆ™NTSMCF ntcf_ntsmcf 𝔑 = ntcf_ntsmcf (𝔐 βˆ™NTCF 𝔑)"
  unfolding 
    ntsmcf_vcomp_def ntcf_ntsmcf_def cat_smc_def nt_field_simps dg_field_simps 
  by (simp add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma ntcf_vcomp_NTMap_vdomain[cat_cs_simps]:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ ((𝔐 βˆ™NTCF 𝔑)⦇NTMap⦈) = 𝔄⦇Obj⦈"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 using assms by auto
  show ?thesis
    by 
      (
        rule ntsmcf_vcomp_NTMap_vdomain
          [
            OF 𝔑.ntcf_is_ntsmcf, 
            of β€Ήntcf_ntsmcf 𝔐›,
            unfolded slicing_commute slicing_simps
          ]
      )
qed

lemma ntcf_vcomp_NTMap_app[cat_cs_simps]:
  assumes "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "a ∈∘ 𝔄⦇Obj⦈" 
  shows "(𝔐 βˆ™NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔐⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 using assms by clarsimp
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 using assms by clarsimp
  show ?thesis
    by 
      (
        rule ntsmcf_vcomp_NTMap_app
          [
            OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
            unfolded slicing_commute slicing_simps,
            OF assms(3)
          ]
      )
qed

lemma ntcf_vcomp_NTMap_vrange:
  assumes "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((𝔐 βˆ™NTCF 𝔑)⦇NTMap⦈) βŠ†βˆ˜ 𝔅⦇Arr⦈"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 using assms by auto
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 using assms by auto
  show ?thesis
    by 
      (
        rule 
          ntsmcf_vcomp_NTMap_vrange[
            OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
            unfolded slicing_simps slicing_commute
          ]
      )
qed


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma ntcf_vcomp_composable_commute[cat_cs_simps]:
  ―‹See Chapter II-4 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and [intro]: "f : a ↦𝔄 b"
  shows 
    "(𝔐⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡b⦈) ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 
      β„Œβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 (𝔐⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈)"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 by (rule assms(1)) 
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis
    by 
      (
        rule ntsmcf_vcomp_composable_commute[
            OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
            unfolded slicing_simps,
            OF assms(3)
          ]
      )
qed 

lemma ntcf_vcomp_is_ntcf[cat_cs_intros]:
  ―‹see Chapter II-4 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔐 βˆ™NTCF 𝔑 : 𝔉 ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis 
  proof(intro is_ntcfI)
    show "vfsequence (𝔐 βˆ™NTCF 𝔑)" by (simp add: ntsmcf_vcomp_def)
    show "vcard (𝔐 βˆ™NTCF 𝔑) = 5β„•"
      unfolding ntsmcf_vcomp_def by (simp add: nat_omega_simps)
    show "ntcf_ntsmcf (𝔐 βˆ™NTCF 𝔑) : 
      cf_smcf 𝔉 ↦SMCF cf_smcf β„Œ : cat_smc 𝔄 ↦↦SMCΞ± cat_smc 𝔅"
      by 
        (
          rule ntsmcf_vcomp_is_ntsmcf[
            OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
            unfolded slicing_simps slicing_commute
            ]
        )
  qed (auto simp: ntsmcf_vcomp_components(1) cat_cs_simps cat_cs_intros)
qed

lemma ntcf_vcomp_assoc[cat_cs_simps]:
  ―‹See Chapter II-4 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔏 : β„Œ ↦CF π”Ž : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "(𝔏 βˆ™NTCF 𝔐) βˆ™NTCF 𝔑 = 𝔏 βˆ™NTCF (𝔐 βˆ™NTCF 𝔑)"
proof-
  interpret 𝔏: is_ntcf Ξ± 𝔄 𝔅 β„Œ π”Ž 𝔏 by (rule assms(1))
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(3))
  show ?thesis
  proof(rule ntcf_eqI[of Ξ±])
    from ntsmcf_vcomp_assoc[
        OF 𝔏.ntcf_is_ntsmcf 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf,
        unfolded slicing_simps slicing_commute
      ]
    have 
      "ntcf_ntsmcf (𝔏 βˆ™NTCF 𝔐 βˆ™NTCF 𝔑)⦇NTMap⦈ =
        ntcf_ntsmcf (𝔏 βˆ™NTCF (𝔐 βˆ™NTCF 𝔑))⦇NTMap⦈"
      by simp
    then show "(𝔏 βˆ™NTCF 𝔐 βˆ™NTCF 𝔑)⦇NTMap⦈ = (𝔏 βˆ™NTCF (𝔐 βˆ™NTCF 𝔑))⦇NTMap⦈"
      unfolding slicing_simps .
  qed (auto intro: cat_cs_intros)
qed


subsubsectionβ€Ή
The opposite of the vertical composition of natural transformations
β€Ί

lemma op_ntcf_ntcf_vcomp[cat_op_simps]: 
  assumes "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "op_ntcf (𝔐 βˆ™NTCF 𝔑) = op_ntcf 𝔑 βˆ™NTCF op_ntcf 𝔐"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 using assms(1) by auto
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 using assms(2) by auto
  show ?thesis
  proof(rule sym, rule ntcf_eqI[of Ξ±])
    from 
      op_ntsmcf_ntsmcf_vcomp
        [
          OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
          unfolded slicing_simps slicing_commute
        ]
    have "ntcf_ntsmcf (op_ntcf 𝔑 βˆ™NTCF op_ntcf 𝔐)⦇NTMap⦈ = 
      ntcf_ntsmcf (op_ntcf (𝔐 βˆ™NTCF 𝔑))⦇NTMap⦈"
      by simp
    then show "(op_ntcf 𝔑 βˆ™NTCF op_ntcf 𝔐)⦇NTMap⦈ = op_ntcf (𝔐 βˆ™NTCF 𝔑)⦇NTMap⦈"
      unfolding slicing_simps .
  qed (auto intro: cat_cs_intros cat_op_intros)
qed



subsectionβ€ΉHorizontal composition of natural transformationsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-5 in \cite{mac_lane_categories_2010}.β€Ί

abbreviation (input) ntcf_hcomp :: "V β‡’ V β‡’ V" (infixl β€Ήβˆ˜NTCFβ€Ί 55)
  where "ntcf_hcomp ≑ ntsmcf_hcomp"

lemmas [cat_cs_simps] = ntsmcf_hcomp_components(2-5)


textβ€ΉSlicing.β€Ί

lemma ntcf_ntsmcf_ntcf_hcomp[slicing_commute]: 
  "ntcf_ntsmcf 𝔐 ∘NTSMCF ntcf_ntsmcf 𝔑 = ntcf_ntsmcf (𝔐 ∘NTCF 𝔑)"
proof(rule vsv_eqI)
  show "vsv (ntcf_ntsmcf 𝔐 ∘NTSMCF ntcf_ntsmcf 𝔑)"
    unfolding ntsmcf_hcomp_def by auto
  show "vsv (ntcf_ntsmcf (𝔐 ∘NTCF 𝔑))" unfolding ntcf_ntsmcf_def by auto
  have dom_lhs: 
    "π’Ÿβˆ˜ (ntcf_ntsmcf 𝔐 ∘NTSMCF ntcf_ntsmcf 𝔑) = 5β„•" 
    unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (ntcf_ntsmcf (𝔐 ∘NTCF 𝔑)) = 5β„•"
    unfolding ntcf_ntsmcf_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (ntcf_ntsmcf 𝔐 ∘NTSMCF ntcf_ntsmcf 𝔑) = 
    π’Ÿβˆ˜ (ntcf_ntsmcf (𝔐 ∘NTCF 𝔑))"
    unfolding dom_lhs dom_rhs ..
  fix a assume "a ∈∘ π’Ÿβˆ˜ (ntcf_ntsmcf 𝔐 ∘NTSMCF ntcf_ntsmcf 𝔑)"
  then show 
    "(ntcf_ntsmcf 𝔐 ∘NTSMCF ntcf_ntsmcf 𝔑)⦇a⦈ = ntcf_ntsmcf (𝔐 ∘NTCF 𝔑)⦇a⦈"
    unfolding dom_lhs
    by (elim_in_numeral; fold nt_field_simps) 
      (simp_all add: ntsmcf_hcomp_components slicing_simps slicing_commute)
qed


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma ntcf_hcomp_NTMap_vdomain[cat_cs_simps]: 
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ ((𝔐 ∘NTCF 𝔑)⦇NTMap⦈) = 𝔄⦇Obj⦈"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  show ?thesis unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
qed

lemma ntcf_hcomp_NTMap_app[cat_cs_simps]:
  assumes "𝔐 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "a ∈∘ 𝔄⦇Obj⦈" 
  shows "(𝔐 ∘NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈ =
    π”Š'⦇ArrMapβ¦ˆβ¦‡π”‘β¦‡NTMapβ¦ˆβ¦‡a⦈⦈ ∘Aβ„­ 𝔐⦇NTMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  from assms(3) show ?thesis 
    unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
qed

lemma ntcf_hcomp_NTMap_vrange:
  assumes "𝔐 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((𝔐 ∘NTCF 𝔑)⦇NTMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis
    by 
      (
        rule ntsmcf_hcomp_NTMap_vrange[
          OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
          unfolded slicing_simps slicing_commute
          ]
      )
qed


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma ntcf_hcomp_composable_commute:
  ―‹See Chapter II-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔐 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­" 
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "f : a ↦𝔄 b" 
  shows 
    "(𝔐 ∘NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ (𝔉' ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ = 
      (π”Š' ∘CF π”Š)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (𝔐 ∘NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈"
    (is β€Ή?𝔐𝔑b ∘Aβ„­ ?𝔉'𝔉f = ?π”Š'π”Šf ∘Aβ„­ ?𝔐𝔑aβ€Ί)
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis
    by 
      (
        rule ntsmcf_hcomp_composable_commute[
          OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf,
          unfolded slicing_simps slicing_commute, 
          OF assms(3)
          ]
      )
qed

lemma ntcf_hcomp_is_ntcf:
  ―‹See Chapter II-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔐 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔐 ∘NTCF 𝔑 : 𝔉' ∘CF 𝔉 ↦CF π”Š' ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis
  proof(intro is_ntcfI) 
    show "vfsequence (𝔐 ∘NTCF 𝔑)"
      unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
    show "vcard (𝔐 ∘NTCF 𝔑) = 5β„•"
      unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
    show "ntcf_ntsmcf (𝔐 ∘NTCF 𝔑) : 
      cf_smcf (𝔉' ∘SMCF 𝔉) ↦SMCF cf_smcf (π”Š' ∘CF π”Š) : 
      cat_smc 𝔄 ↦↦SMCΞ± cat_smc β„­"
      by 
        (
          rule ntsmcf_hcomp_is_ntsmcf[
            OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
            unfolded slicing_simps slicing_commute
            ]
        )
  qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps intro: cat_cs_intros)
qed

lemma ntcf_hcomp_is_ntcf'[cat_cs_intros]:
  assumes "𝔐 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­" 
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔖 = 𝔉' ∘CF 𝔉"
    and "𝔖' = π”Š' ∘CF π”Š"
  shows "𝔐 ∘NTCF 𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 ↦↦CΞ± β„­"
  using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_ntcf)

lemma ntcf_hcomp_associativ[cat_cs_simps]: 
  assumes "𝔏 : 𝔉'' ↦CF π”Š'' : β„­ ↦↦CΞ± 𝔇" 
    and "𝔐 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "(𝔏 ∘NTCF 𝔐) ∘NTCF 𝔑 = 𝔏 ∘NTCF (𝔐 ∘NTCF 𝔑)"
proof-
  interpret 𝔏: is_ntcf Ξ± β„­ 𝔇 𝔉'' π”Š'' 𝔏 by (rule assms(1))
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' 𝔐 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(3))
  show ?thesis
  proof(rule ntcf_eqI[of Ξ±])
    show "𝔏 ∘NTCF (𝔐 ∘NTCF 𝔑) : 
      𝔉'' ∘CF 𝔉' ∘CF 𝔉 ↦CF π”Š'' ∘CF π”Š' ∘CF π”Š : 𝔄 ↦↦CΞ± 𝔇"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from ntsmcf_hcomp_assoc[
      OF 𝔏.ntcf_is_ntsmcf 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf,
      unfolded slicing_commute
      ]
    have 
      "ntcf_ntsmcf (𝔏 ∘NTCF 𝔐 ∘NTCF 𝔑)⦇NTMap⦈ = 
        ntcf_ntsmcf (𝔏 ∘NTCF (𝔐 ∘NTCF 𝔑))⦇NTMap⦈"
      by simp
    then show "(𝔏 ∘NTCF 𝔐 ∘NTCF 𝔑)⦇NTMap⦈ = (𝔏 ∘NTCF (𝔐 ∘NTCF 𝔑))⦇NTMap⦈"
      unfolding slicing_simps .
  qed (auto intro: cat_cs_intros)
qed


subsubsectionβ€Ή
The opposite of the horizontal composition of natural transformations
β€Ί

lemma op_ntcf_ntcf_hcomp[cat_op_simps]: 
  assumes "𝔐 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "op_ntcf (𝔐 ∘NTCF 𝔑) = op_ntcf 𝔐 ∘NTCF op_ntcf 𝔑"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis
  proof(rule sym, rule ntcf_eqI[of Ξ±])
    from op_ntsmcf_ntsmcf_hcomp[
        OF 𝔐.ntcf_is_ntsmcf 𝔑.ntcf_is_ntsmcf, 
        unfolded slicing_simps slicing_commute 
        ]
    have "ntcf_ntsmcf (op_ntcf 𝔐 ∘NTCF op_ntcf 𝔑)⦇NTMap⦈ =
      ntcf_ntsmcf (op_ntcf (𝔐 ∘NTCF 𝔑))⦇NTMap⦈"
      by simp
    then show "(op_ntcf 𝔐 ∘NTCF op_ntcf 𝔑)⦇NTMap⦈ = op_ntcf (𝔐 ∘NTCF 𝔑)⦇NTMap⦈"
      unfolding slicing_simps .
    have "𝔐 ∘NTCF 𝔑 : 𝔉' ∘CF 𝔉 ↦CF π”Š' ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
      by (rule ntcf_hcomp_is_ntcf[OF assms])
    from is_ntcf.is_ntcf_op[OF this] show 
      "op_ntcf (𝔐 ∘NTCF 𝔑) : 
        op_cf π”Š' ∘CF op_cf π”Š ↦CF op_cf 𝔉' ∘CF op_cf 𝔉 : 
        op_cat 𝔄 ↦↦CΞ± op_cat β„­"
      unfolding cat_op_simps .
  qed (auto intro: cat_op_intros cat_cs_intros)
qed 



subsectionβ€ΉInterchange lawβ€Ί

lemma ntcf_comp_interchange_law:
  ―‹See Chapter II-5 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔐' : π”Š' ↦CF β„Œ' : 𝔅 ↦↦CΞ± β„­"
    and "𝔑' : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
  shows "((𝔐' βˆ™NTCF 𝔑') ∘NTCF (𝔐 βˆ™NTCF 𝔑)) = (𝔐' ∘NTCF 𝔐) βˆ™NTCF (𝔑' ∘NTCF 𝔑)"
proof-
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  interpret 𝔐': is_ntcf Ξ± 𝔅 β„­ π”Š' β„Œ' 𝔐' by (rule assms(3))
  interpret 𝔑': is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' 𝔑' by (rule assms(4))
  show ?thesis
  proof(rule ntcf_eqI)
    from ntsmcf_comp_interchange_law
      [
        OF 
          𝔐.ntcf_is_ntsmcf 
          𝔑.ntcf_is_ntsmcf 
          𝔐'.ntcf_is_ntsmcf 
          𝔑'.ntcf_is_ntsmcf
      ]
    have 
      "(
        (ntcf_ntsmcf 𝔐' βˆ™NTSMCF ntcf_ntsmcf 𝔑') ∘NTSMCF
        (ntcf_ntsmcf 𝔐 βˆ™NTSMCF ntcf_ntsmcf 𝔑)
       )⦇NTMap⦈ =
        (
          (ntcf_ntsmcf 𝔐' ∘NTSMCF ntcf_ntsmcf 𝔐) βˆ™NTCF
          (ntcf_ntsmcf 𝔑' ∘NTSMCF ntcf_ntsmcf 𝔑)
        )⦇NTMap⦈"
      by simp
    then show 
      "(𝔐' βˆ™NTCF 𝔑' ∘NTCF (𝔐 βˆ™NTCF 𝔑))⦇NTMap⦈ =
        (𝔐' ∘NTCF 𝔐 βˆ™NTCF (𝔑' ∘NTCF 𝔑))⦇NTMap⦈"
      unfolding slicing_simps slicing_commute .
  qed (auto intro: cat_cs_intros)
qed



subsectionβ€ΉIdentity natural transformationβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-4 in \cite{mac_lane_categories_2010}.β€Ί

definition ntcf_id :: "V β‡’ V"
  where "ntcf_id 𝔉 = [𝔉⦇HomCodβ¦ˆβ¦‡CId⦈ ∘∘ 𝔉⦇ObjMap⦈, 𝔉, 𝔉, 𝔉⦇HomDom⦈, 𝔉⦇HomCod⦈]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_id_components:
  shows "ntcf_id 𝔉⦇NTMap⦈ = 𝔉⦇HomCodβ¦ˆβ¦‡CId⦈ ∘∘ 𝔉⦇ObjMap⦈"
    and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id 𝔉⦇NTDom⦈ = 𝔉" 
    and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id 𝔉⦇NTCod⦈ = 𝔉" 
    and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id 𝔉⦇NTDGDom⦈ = 𝔉⦇HomDom⦈" 
    and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id 𝔉⦇NTDGCod⦈ = 𝔉⦇HomCod⦈" 
  unfolding ntcf_id_def nt_field_simps by (simp_all add: nat_omega_simps)

lemma (in is_functor) is_functor_ntcf_id_components:
  shows "ntcf_id 𝔉⦇NTMap⦈ = 𝔅⦇CId⦈ ∘∘ 𝔉⦇ObjMap⦈"
    and "ntcf_id 𝔉⦇NTDom⦈ = 𝔉" 
    and "ntcf_id 𝔉⦇NTCod⦈ = 𝔉" 
    and "ntcf_id 𝔉⦇NTDGDom⦈ = 𝔄" 
    and "ntcf_id 𝔉⦇NTDGCod⦈ = 𝔅" 
  unfolding ntcf_id_components by (simp_all add: cat_cs_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma (in is_functor) ntcf_id_NTMap_vdomain[cat_cs_simps]: 
  "π’Ÿβˆ˜ (ntcf_id 𝔉⦇NTMap⦈) = 𝔄⦇Obj⦈"
  using cf_ObjMap_vrange unfolding is_functor_ntcf_id_components 
  by (auto simp: cat_cs_simps)

lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_vdomain

lemma (in is_functor) ntcf_id_NTMap_app_vdomain[cat_cs_simps]: 
  assumes [simp]: "a ∈∘ 𝔄⦇Obj⦈"
  shows "ntcf_id 𝔉⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
  unfolding is_functor_ntcf_id_components
  by (rule vsv_vcomp_at) (auto simp: cf_ObjMap_vrange cat_cs_simps cat_cs_intros)

lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_app_vdomain

lemma (in is_functor) ntcf_id_NTMap_vsv[cat_cs_intros]: 
  "vsv (ntcf_id 𝔉⦇NTMap⦈)"
  unfolding is_functor_ntcf_id_components by (auto intro: vsv_vcomp)

lemmas [cat_cs_intros] = is_functor.ntcf_id_NTMap_vsv

lemma (in is_functor) ntcf_id_NTMap_vrange: 
  "β„›βˆ˜ (ntcf_id 𝔉⦇NTMap⦈) βŠ†βˆ˜ 𝔅⦇Arr⦈"
proof(rule vsubsetI)
  interpret vsv β€Ήntcf_id 𝔉⦇NTMapβ¦ˆβ€Ί by (rule ntcf_id_NTMap_vsv)
  fix f assume "f ∈∘ β„›βˆ˜ (ntcf_id 𝔉⦇NTMap⦈)"
  then obtain a 
    where f_def: "f = ntcf_id 𝔉⦇NTMapβ¦ˆβ¦‡a⦈" and a: "a ∈∘ π’Ÿβˆ˜ (ntcf_id 𝔉⦇NTMap⦈)"
    using vrange_atD by metis
  then have "a ∈∘ 𝔄⦇Obj⦈" and "f = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
    by (auto simp: cat_cs_simps)
  then show "f ∈∘ 𝔅⦇Arr⦈"
    by (auto dest: cf_ObjMap_app_in_HomCod_Obj HomCod.cat_CId_is_arr)
qed


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in is_functor) cf_ntcf_id_is_ntcf[cat_cs_intros]: 
  "ntcf_id 𝔉 : 𝔉 ↦CF 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
proof(rule is_ntcfI, unfold is_functor_ntcf_id_components(2,3,4,5))
  show "ntcf_ntsmcf (ntcf_id 𝔉) : 
    cf_smcf 𝔉 ↦SMCF cf_smcf 𝔉 : cat_smc 𝔄 ↦↦SMCΞ± cat_smc 𝔅"
  proof
    (
      rule is_ntsmcfI, 
      unfold slicing_simps slicing_commute is_functor_ntcf_id_components(2,3,4,5)
    )
    show "ntsmcf_tdghm (ntcf_ntsmcf (ntcf_id 𝔉)) : 
      smcf_dghm (cf_smcf 𝔉) ↦DGHM smcf_dghm (cf_smcf 𝔉) : 
      smc_dg (cat_smc 𝔄) ↦↦DGΞ± smc_dg (cat_smc 𝔅)"
      by
        (
          rule is_tdghmI, 
          unfold 
            slicing_simps 
            slicing_commute 
            is_functor_ntcf_id_components(2,3,4,5)
        )
        (
          auto 
            simp:
              cat_cs_simps
              cat_cs_intros
              nat_omega_simps
              ntsmcf_tdghm_def
              cf_is_semifunctor 
            intro: slicing_intros
        )
    fix f a b assume "f : a ↦𝔄 b"
    with is_functor_axioms show "ntcf_id 𝔉⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 
      𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 ntcf_id 𝔉⦇NTMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: ntcf_ntsmcf_def nat_omega_simps intro: slicing_intros)
qed (auto simp: ntcf_id_def nat_omega_simps intro: cat_cs_intros)

lemma (in is_functor) cf_ntcf_id_is_ntcf': 
  assumes "π”Š' = 𝔉" and "β„Œ' = 𝔉"
  shows "ntcf_id 𝔉 : π”Š' ↦CF β„Œ' : 𝔄 ↦↦CΞ± 𝔅"
  unfolding assms by (rule cf_ntcf_id_is_ntcf)

lemmas [cat_cs_intros] = is_functor.cf_ntcf_id_is_ntcf'

lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_left_left[cat_cs_simps]:
  ―‹See Chapter II-4 in \cite{mac_lane_categories_2010}.β€Ί
  "ntcf_id π”Š βˆ™NTCF 𝔑 = 𝔑"
proof(rule ntcf_eqI[of Ξ±])
  interpret id: is_ntcf Ξ± 𝔄 𝔅 π”Š π”Š β€Ήntcf_id π”Šβ€Ί 
    by (rule NTCod.cf_ntcf_id_is_ntcf)
  show "(ntcf_id π”Š βˆ™NTCF 𝔑)⦇NTMap⦈ = 𝔑⦇NTMap⦈"
  proof(rule vsv_eqI)
    show [simp]: "π’Ÿβˆ˜ ((ntcf_id π”Š βˆ™NTCF 𝔑)⦇NTMap⦈) = π’Ÿβˆ˜ (𝔑⦇NTMap⦈)"
      unfolding ntsmcf_vcomp_components 
      by (simp add: cat_cs_simps)
    fix a assume "a ∈∘ π’Ÿβˆ˜ ((ntcf_id π”Š βˆ™NTCF 𝔑)⦇NTMap⦈)"
    then have "a ∈∘ 𝔄⦇Obj⦈" by (simp add: cat_cs_simps)
    then show "(ntcf_id π”Š βˆ™NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: ntsmcf_vcomp_components)
qed (auto intro: cat_cs_intros)

lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_left_left

lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_right_left[cat_cs_simps]: 
  ―‹See Chapter II-4 in \cite{mac_lane_categories_2010}.β€Ί
  "𝔑 βˆ™NTCF ntcf_id 𝔉 = 𝔑"
proof(rule ntcf_eqI[of Ξ±])
  interpret id: is_ntcf Ξ± 𝔄 𝔅 𝔉 𝔉 β€Ήntcf_id 𝔉›    
    by (rule NTDom.cf_ntcf_id_is_ntcf)
  show "(𝔑 βˆ™NTCF ntcf_id 𝔉)⦇NTMap⦈ = 𝔑⦇NTMap⦈"
  proof(rule vsv_eqI)
    show [simp]: "π’Ÿβˆ˜ ((𝔑 βˆ™NTCF ntcf_id 𝔉)⦇NTMap⦈) = π’Ÿβˆ˜ (𝔑⦇NTMap⦈)"
      unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)
    fix a assume "a ∈∘ π’Ÿβˆ˜ ((𝔑 βˆ™NTCF ntcf_id 𝔉)⦇NTMap⦈)"
    then have "a ∈∘ 𝔄⦇Obj⦈" by (simp add: cat_cs_simps)
    then show "(𝔑 βˆ™NTCF ntcf_id 𝔉)⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡a⦈" 
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: ntsmcf_vcomp_components)
qed (auto intro: cat_cs_intros)

lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_right_left

lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_left_left[cat_cs_simps]:
  ―‹See Chapter II-5 in \cite{mac_lane_categories_2010}.β€Ί
  "ntcf_id (cf_id 𝔅) ∘NTCF 𝔑 = 𝔑"
proof(rule ntcf_eqI)
  interpret id: is_ntcf Ξ± 𝔅 𝔅 β€Ήcf_id 𝔅› β€Ήcf_id 𝔅› β€Ήntcf_id (cf_id 𝔅)β€Ί 
    by 
      (
        simp add: 
          NTDom.HomCod.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
      )
  show "ntcf_id (cf_id 𝔅) ∘NTCF 𝔑 : 
    cf_id 𝔅 ∘CF 𝔉 ↦CF cf_id 𝔅 ∘CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: cat_cs_intros)
  show "(ntcf_id (cf_id 𝔅) ∘NTCF 𝔑)⦇NTMap⦈ = 𝔑⦇NTMap⦈"
  proof(rule vsv_eqI)
    fix a assume "a ∈∘ π’Ÿβˆ˜ ((ntcf_id (cf_id 𝔅) ∘NTCF 𝔑)⦇NTMap⦈)"    
    then have a: "a ∈∘ 𝔄⦇Obj⦈" 
      unfolding ntcf_hcomp_NTMap_vdomain[OF is_ntcf_axioms] by simp
    with is_ntcf_axioms show 
      "(ntcf_id (cf_id 𝔅) ∘NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
qed (auto simp: cat_cs_simps intro: cat_cs_intros)

lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_left_left

lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_right_left[cat_cs_simps]: 
  ―‹See Chapter II-5 in \cite{mac_lane_categories_2010}.β€Ί
  "𝔑 ∘NTCF ntcf_id (cf_id 𝔄) = 𝔑"
proof(rule ntcf_eqI[of Ξ±])
  interpret id: is_ntcf Ξ± 𝔄 𝔄 β€Ήcf_id 𝔄› β€Ήcf_id 𝔄› β€Ήntcf_id (cf_id 𝔄)β€Ί 
    by 
      (
        simp add: 
          NTDom.HomDom.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
      )
  show "𝔑 ∘NTCF ntcf_id (cf_id 𝔄) :
    𝔉 ∘CF cf_id 𝔄 ↦CF π”Š ∘CF cf_id 𝔄 : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: cat_cs_intros)
  show "(𝔑 ∘NTCF ntcf_id (cf_id 𝔄))⦇NTMap⦈ = 𝔑⦇NTMap⦈"
  proof(rule vsv_eqI)
    fix a assume "a ∈∘ π’Ÿβˆ˜ ((𝔑 ∘NTCF ntcf_id (cf_id 𝔄))⦇NTMap⦈)"
    then have a: "a ∈∘ 𝔄⦇Obj⦈" 
      unfolding ntcf_hcomp_NTMap_vdomain[OF id.is_ntcf_axioms] by simp
    with is_ntcf_axioms show 
      "(𝔑 ∘NTCF ntcf_id (cf_id 𝔄))⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
qed (auto simp: cat_cs_simps cat_cs_intros)

lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_right_left


subsubsectionβ€ΉThe opposite identity natural transformationβ€Ί

lemma (in is_functor) cf_ntcf_id_op_cf: "ntcf_id (op_cf 𝔉) = op_ntcf (ntcf_id 𝔉)"
proof(rule ntcf_eqI)
  show ntcfid_op: 
    "ntcf_id (op_cf 𝔉) : op_cf 𝔉 ↦CF op_cf 𝔉 : op_cat 𝔄 ↦↦CΞ± op_cat 𝔅"
    by (simp add: is_functor.cf_ntcf_id_is_ntcf local.is_functor_op)
  show "ntcf_id (op_cf 𝔉)⦇NTMap⦈ = op_ntcf (ntcf_id 𝔉)⦇NTMap⦈"
    by (rule vsv_eqI, unfold cat_op_simps)
      (
        auto 
          simp: cat_op_simps cat_cs_simps ntcf_id_components(1) 
          intro: vsv_vcomp
      )
qed (auto intro: cat_op_intros cat_cs_intros)


subsubsectionβ€ΉIdentity natural transformation of a composition of functorsβ€Ί

lemma ntcf_id_cf_comp:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "ntcf_id (π”Š ∘CF 𝔉) = ntcf_id π”Š ∘NTCF ntcf_id 𝔉"
proof(rule ntcf_eqI)
  from assms show π”Šπ”‰: "ntcf_id (π”Š ∘CF 𝔉) : π”Š ∘CF 𝔉 ↦CF π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  interpret π”Šπ”‰: is_ntcf Ξ± 𝔄 β„­ β€Ήπ”Š ∘CF 𝔉› β€Ήπ”Š ∘CF 𝔉› β€Ήntcf_id (π”Š ∘CF 𝔉)β€Ί
    by (rule π”Šπ”‰)
  from assms show π”Š_𝔉:
    "ntcf_id π”Š ∘NTCF ntcf_id 𝔉 : π”Š ∘CF 𝔉 ↦CF π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  interpret π”Š_𝔉: is_ntcf Ξ± 𝔄 β„­ β€Ήπ”Š ∘CF 𝔉› β€Ήπ”Š ∘CF 𝔉› β€Ήntcf_id π”Š ∘NTCF ntcf_id 𝔉›
    by (rule π”Š_𝔉)
  show "ntcf_id (π”Š ∘CF 𝔉)⦇NTMap⦈ = (ntcf_id π”Š ∘NTCF ntcf_id 𝔉)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold π”Šπ”‰.ntcf_NTMap_vdomain π”Š_𝔉.ntcf_NTMap_vdomain)
    fix a assume "a ∈∘ 𝔄⦇Obj⦈"
    with assms show 
      "ntcf_id (π”Š ∘CF 𝔉)⦇NTMapβ¦ˆβ¦‡a⦈ = (ntcf_id π”Š ∘NTCF ntcf_id 𝔉)⦇NTMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed auto
qed auto

lemmas [cat_cs_simps] = ntcf_id_cf_comp[symmetric]



subsectionβ€ΉComposition of a natural transformation and a functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

abbreviation (input) ntcf_cf_comp :: "V β‡’ V β‡’ V" (infixl "∘NTCF-CF" 55)
  where "ntcf_cf_comp ≑ tdghm_dghm_comp"


textβ€ΉSlicing.β€Ί

lemma ntsmcf_tdghm_ntsmcf_smcf_comp[slicing_commute]: 
  "ntcf_ntsmcf 𝔑 ∘NTSMCF-SMCF cf_smcf β„Œ = ntcf_ntsmcf (𝔑 ∘NTCF-CF β„Œ)"
  unfolding 
    ntcf_ntsmcf_def
    cf_smcf_def
    cat_smc_def
    tdghm_dghm_comp_def 
    dghm_comp_def 
    ntsmcf_tdghm_def 
    smcf_dghm_def
    smc_dg_def
    dg_field_simps
    dghm_field_simps 
    nt_field_simps 
  by (simp add: nat_omega_simps) (*slow*)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda (in is_functor) 
  tdghm_dghm_comp_components(1)[where β„Œ=𝔉, unfolded cf_HomDom]
  |vdomain ntcf_cf_comp_NTMap_vdomain[cat_cs_simps]|
  |app ntcf_cf_comp_NTMap_app[cat_cs_simps]|

lemmas [cat_cs_simps] = 
  is_functor.ntcf_cf_comp_NTMap_vdomain
  is_functor.ntcf_cf_comp_NTMap_app

lemma ntcf_cf_comp_NTMap_vrange: 
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" and "β„Œ : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((𝔑 ∘NTCF-CF β„Œ)⦇NTMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔄 𝔅 β„Œ by (rule assms(2))
  show ?thesis unfolding tdghm_dghm_comp_components 
    by (auto simp: cat_cs_simps intro: cat_cs_intros)
qed


subsubsectionβ€Ή
Opposite of the composition of a natural transformation and a functor
β€Ί

lemma op_ntcf_ntcf_cf_comp[cat_op_simps]:
  "op_ntcf (𝔑 ∘NTCF-CF β„Œ) = op_ntcf 𝔑 ∘NTCF-CF op_cf β„Œ"
  unfolding 
    tdghm_dghm_comp_def 
    dghm_comp_def 
    op_ntcf_def 
    op_cf_def 
    op_cat_def
    dg_field_simps
    dghm_field_simps
    nt_field_simps
  by (simp add: nat_omega_simps) (*slow*)


subsubsectionβ€Ή
Composition of a natural transformation and a
functor is a natural transformation
β€Ί

lemma ntcf_cf_comp_is_ntcf:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" and "β„Œ : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔑 ∘NTCF-CF β„Œ : 𝔉 ∘CF β„Œ ↦CF π”Š ∘CF β„Œ : 𝔄 ↦↦CΞ± β„­"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔄 𝔅 β„Œ by (rule assms(2))
  show ?thesis
  proof(rule is_ntcfI)
    show "vfsequence (𝔑 ∘NTCF-CF β„Œ)"
      unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
    from assms show "𝔉 ∘CF β„Œ : 𝔄 ↦↦CΞ± β„­" 
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "π”Š ∘CF β„Œ : 𝔄 ↦↦CΞ± β„­" 
      by (cs_concl cs_intro: cat_cs_intros)
    show "vcard (𝔑 ∘NTCF-CF β„Œ) = 5β„•"
      unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
    from assms show 
      "ntcf_ntsmcf (𝔑 ∘NTCF-CF β„Œ) :
        cf_smcf (𝔉 ∘CF β„Œ) ↦SMCF cf_smcf (π”Š ∘CF β„Œ) :
        cat_smc 𝔄 ↦↦SMCΞ± cat_smc β„­"
      by 
        (
          cs_concl 
            cs_simp: slicing_commute[symmetric] 
            cs_intro: slicing_intros smc_cs_intros cat_cs_intros
        )
  qed (auto simp: tdghm_dghm_comp_components(1) cat_cs_simps)
qed

lemma ntcf_cf_comp_is_functor'[cat_cs_intros]:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" 
    and "β„Œ : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉' = 𝔉 ∘CF β„Œ"
    and "π”Š' = π”Š ∘CF β„Œ"
  shows "𝔑 ∘NTCF-CF β„Œ : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± β„­"
  using assms(1,2) unfolding assms(3,4) by (simp add: ntcf_cf_comp_is_ntcf)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma ntcf_cf_comp_ntcf_cf_comp_assoc:
  assumes "𝔑 : β„Œ ↦CF β„Œ' : β„­ ↦↦CΞ± 𝔇" 
    and "π”Š : 𝔅 ↦↦CΞ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "(𝔑 ∘NTCF-CF π”Š) ∘NTCF-CF 𝔉 = 𝔑 ∘NTCF-CF (π”Š ∘CF 𝔉)"
proof-
  interpret 𝔑: is_ntcf Ξ± β„­ 𝔇 β„Œ β„Œ' 𝔑 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))
  interpret 𝔉: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(3))
  show ?thesis  
  proof(rule ntcf_ntsmcf_eqI)
    from assms show
      "(𝔑 ∘NTCF-CF π”Š) ∘NTCF-CF 𝔉 :
        β„Œ ∘CF π”Š ∘CF 𝔉 ↦CF β„Œ' ∘CF π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± 𝔇"
      by (cs_concl cs_intro: cat_cs_intros)
    show "𝔑 ∘NTCF-CF (π”Š ∘CF 𝔉) :
      β„Œ ∘CF π”Š ∘CF 𝔉 ↦CF β„Œ' ∘CF π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± 𝔇"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms show 
      "ntcf_ntsmcf ((𝔑 ∘NTCF-CF π”Š) ∘NTCF-CF 𝔉) =
        ntcf_ntsmcf (𝔑 ∘NTCF-CF (π”Š ∘CF 𝔉))"
      by 
        (
          cs_concl
            cs_simp: slicing_commute[symmetric] 
            cs_intro: slicing_intros ntsmcf_smcf_comp_ntsmcf_smcf_comp_assoc
        )
  qed simp_all
qed

lemma (in is_ntcf) ntcf_ntcf_cf_comp_cf_id[cat_cs_simps]:
  "𝔑 ∘NTCF-CF cf_id 𝔄 = 𝔑"
proof(rule ntcf_ntsmcf_eqI)
  show "𝔑 ∘NTCF-CF cf_id 𝔄 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: cat_cs_intros)
  show "ntcf_ntsmcf (𝔑 ∘NTCF-CF cf_id 𝔄) = ntcf_ntsmcf 𝔑"
    by
      (
        cs_concl
          cs_simp: slicing_commute[symmetric] 
          cs_intro: cat_cs_intros slicing_intros smc_cs_simps
      )
qed simp_all

lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_cf_comp_cf_id

lemma ntcf_vcomp_ntcf_cf_comp[cat_cs_simps]:
  assumes "π”Ž : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔐 : π”Š ↦CF β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "(𝔐 ∘NTCF-CF π”Ž) βˆ™NTCF (𝔑 ∘NTCF-CF π”Ž) = (𝔐 βˆ™NTCF 𝔑) ∘NTCF-CF π”Ž"
proof(rule ntcf_ntsmcf_eqI)
  from assms show 
    "𝔐 ∘NTCF-CF π”Ž βˆ™NTCF (𝔑 ∘NTCF-CF π”Ž) :
      𝔉 ∘CF π”Ž ↦CF β„Œ ∘CF π”Ž : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  from assms show 
    "ntcf_ntsmcf (𝔐 ∘NTCF-CF π”Ž βˆ™NTCF (𝔑 ∘NTCF-CF π”Ž)) =
      ntcf_ntsmcf (𝔐 βˆ™NTCF 𝔑 ∘NTCF-CF π”Ž)"
    unfolding slicing_commute[symmetric]
    by (intro ntsmcf_vcomp_ntsmcf_smcf_comp)
      (cs_concl cs_intro: slicing_intros)
qed (use assms in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+



subsectionβ€ΉComposition of a functor and a natural transformationβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

abbreviation (input) cf_ntcf_comp :: "V β‡’ V β‡’ V" (infixl "∘CF-NTCF" 55)
  where "cf_ntcf_comp ≑ dghm_tdghm_comp"


textβ€ΉSlicing.β€Ί

lemma ntcf_ntsmcf_cf_ntcf_comp[slicing_commute]: 
  "cf_smcf β„Œ ∘SMCF-NTSMCF ntcf_ntsmcf 𝔑 = ntcf_ntsmcf (β„Œ ∘CF-NTCF 𝔑)"
  unfolding 
    ntcf_ntsmcf_def
    cf_smcf_def
    cat_smc_def
    dghm_tdghm_comp_def 
    dghm_comp_def 
    ntsmcf_tdghm_def 
    smcf_dghm_def 
    smc_dg_def
    dg_field_simps
    dghm_field_simps 
    nt_field_simps 
  by (simp add: nat_omega_simps) (*slow*)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda (in is_ntcf) 
  dghm_tdghm_comp_components(1)[where 𝔑=𝔑, unfolded ntcf_NTDGDom]
  |vdomain cf_ntcf_comp_NTMap_vdomain|
  |app cf_ntcf_comp_NTMap_app|

lemmas [cat_cs_simps] = 
  is_ntcf.cf_ntcf_comp_NTMap_vdomain
  is_ntcf.cf_ntcf_comp_NTMap_app

lemma cf_ntcf_comp_NTMap_vrange: 
  assumes "β„Œ : 𝔅 ↦↦CΞ± β„­" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„›βˆ˜ ((β„Œ ∘CF-NTCF 𝔑)⦇NTMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis 
    unfolding dghm_tdghm_comp_components 
    by (auto simp: cat_cs_simps intro: cat_cs_intros)
qed


subsubsectionβ€Ή
Opposite of the composition of a functor and a natural transformation
β€Ί

lemma op_ntcf_cf_ntcf_comp[cat_op_simps]:
  "op_ntcf (β„Œ ∘CF-NTCF 𝔑) = op_cf β„Œ ∘CF-NTCF op_ntcf 𝔑"
  unfolding 
    dghm_tdghm_comp_def
    dghm_comp_def
    op_ntcf_def
    op_cf_def
    op_cat_def
    dg_field_simps
    dghm_field_simps
    nt_field_simps
  by (simp add: nat_omega_simps) (*slow*)


subsubsectionβ€Ή
Composition of a functor and a natural transformation 
is a natural transformation
β€Ί

lemma cf_ntcf_comp_is_ntcf:
  assumes "β„Œ : 𝔅 ↦↦CΞ± β„­" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "β„Œ ∘CF-NTCF 𝔑 : β„Œ ∘CF 𝔉 ↦CF β„Œ ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
proof-
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis
  proof(rule is_ntcfI)
    show "vfsequence (β„Œ ∘CF-NTCF 𝔑)" unfolding dghm_tdghm_comp_def by simp
    from assms show "β„Œ ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­" 
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "β„Œ ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_cs_intros)
    show "vcard (β„Œ ∘CF-NTCF 𝔑) = 5β„•"
      unfolding dghm_tdghm_comp_def by (simp add: nat_omega_simps)
    from assms show "ntcf_ntsmcf (β„Œ ∘CF-NTCF 𝔑) :
      cf_smcf (β„Œ ∘CF 𝔉) ↦SMCF cf_smcf (β„Œ ∘CF π”Š) :
      cat_smc 𝔄 ↦↦SMCΞ± cat_smc β„­"
      by 
        (
          cs_concl 
            cs_simp: slicing_commute[symmetric]
            cs_intro: slicing_intros smc_cs_intros 
        )
  qed (auto simp: dghm_tdghm_comp_components(1) cat_cs_simps)
qed

lemma cf_ntcf_comp_is_functor'[cat_cs_intros]:
  assumes "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉' = β„Œ ∘CF 𝔉"
    and "π”Š' = β„Œ ∘CF π”Š"
  shows "β„Œ ∘CF-NTCF 𝔑 : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± β„­"
  using assms(1,2) unfolding assms(3,4) by (simp add: cf_ntcf_comp_is_ntcf)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma cf_comp_cf_ntcf_comp_assoc:
  assumes "𝔑 : β„Œ ↦CF β„Œ' : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : β„­ ↦↦CΞ± 𝔇"
  shows "(π”Š ∘CF 𝔉) ∘CF-NTCF 𝔑 = π”Š ∘CF-NTCF (𝔉 ∘CF-NTCF 𝔑)"
proof(rule ntcf_ntsmcf_eqI)
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 β„Œ β„Œ' 𝔑 by (rule assms(1))
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(2))
  interpret π”Š: is_functor Ξ± β„­ 𝔇 π”Š by (rule assms(3))
  from assms show "(π”Š ∘CF 𝔉) ∘CF-NTCF 𝔑 :
    π”Š ∘CF 𝔉 ∘CF β„Œ ↦CF π”Š ∘CF 𝔉 ∘CF β„Œ' : 𝔄 ↦↦CΞ± 𝔇"
    by (cs_concl cs_intro: cat_cs_intros)
  from assms show "π”Š ∘CF-NTCF (𝔉 ∘CF-NTCF 𝔑) :
    π”Š ∘CF 𝔉 ∘CF β„Œ ↦CF π”Š ∘CF 𝔉 ∘CF β„Œ' : 𝔄 ↦↦CΞ± 𝔇"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms show 
    "ntcf_ntsmcf (π”Š ∘CF 𝔉 ∘CF-NTCF 𝔑) =
      ntcf_ntsmcf (π”Š ∘CF-NTCF (𝔉 ∘CF-NTCF 𝔑))"
    by
      (
        cs_concl
          cs_simp: slicing_commute[symmetric] 
          cs_intro: slicing_intros smcf_comp_smcf_ntsmcf_comp_assoc
      )
qed simp_all

lemma (in is_ntcf) ntcf_cf_ntcf_comp_cf_id[cat_cs_simps]:
  "cf_id 𝔅 ∘CF-NTCF 𝔑 = 𝔑"
proof(rule ntcf_ntsmcf_eqI)
  show "cf_id 𝔅 ∘CF-NTCF 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: cat_cs_intros)
  show "ntcf_ntsmcf (smcf_id 𝔅 ∘SMCF-NTSMCF 𝔑) = ntcf_ntsmcf 𝔑"
    by 
      (
        cs_concl
          cs_simp: slicing_commute[symmetric] 
          cs_intro: cat_cs_intros slicing_intros smc_cs_simps
      )
qed simp_all

lemmas [cat_cs_simps] = is_ntcf.ntcf_cf_ntcf_comp_cf_id

lemma cf_ntcf_comp_ntcf_cf_comp_assoc:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "β„Œ : β„­ ↦↦CΞ± 𝔇"
    and "π”Ž : 𝔄 ↦↦CΞ± 𝔅"
  shows "(β„Œ ∘CF-NTCF 𝔑) ∘NTCF-CF π”Ž = β„Œ ∘CF-NTCF (𝔑 ∘NTCF-CF π”Ž)"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_functor Ξ± β„­ 𝔇 β„Œ by (rule assms(2))
  interpret π”Ž: is_functor Ξ± 𝔄 𝔅 π”Ž by (rule assms(3))
  show ?thesis
    by (rule ntcf_ntsmcf_eqI)
      (
        use assms in
          β€Ή
            cs_concl
              cs_simp: cat_cs_simps slicing_commute[symmetric]
              cs_intro:
                cat_cs_intros
                slicing_intros
                smcf_ntsmcf_comp_ntsmcf_smcf_comp_assoc
          β€Ί
      )+
qed

lemma ntcf_cf_comp_ntcf_id[cat_cs_simps]:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "π”Ž : 𝔄 ↦↦CΞ± 𝔅"
  shows "ntcf_id 𝔉 ∘NTCF-CF π”Ž = ntcf_id 𝔉 ∘NTCF ntcf_id π”Ž"
proof(rule ntcf_eqI)
  from assms have dom_lhs: "π’Ÿβˆ˜ ((ntcf_id 𝔉 ∘NTCF-CF π”Ž)⦇NTMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from assms have dom_rhs: "π’Ÿβˆ˜ ((ntcf_id 𝔉 ∘NTCF ntcf_id π”Ž)⦇NTMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "(ntcf_id 𝔉 ∘NTCF-CF π”Ž)⦇NTMap⦈ = (ntcf_id 𝔉 ∘NTCF ntcf_id π”Ž)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume "a ∈∘ 𝔄⦇Obj⦈"
    with assms show 
      "(ntcf_id 𝔉 ∘NTCF-CF π”Ž)⦇NTMapβ¦ˆβ¦‡a⦈ = (ntcf_id 𝔉 ∘NTCF ntcf_id π”Ž)⦇NTMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto intro: cat_cs_intros)
qed (use assms in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+

lemma cf_comp_cf_const_right[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "π”ž ∈∘ 𝔅⦇Obj⦈"
  shows "π”Š ∘CF cf_const 𝔄 𝔅 π”ž = cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)"
proof(rule cf_eqI)

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(3))

  from assms(4) show "π”Š ∘CF cf_const 𝔄 𝔅 π”ž : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  from assms(4) show "cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ) : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(4) have ObjMap_dom_lhs: 
    "π’Ÿβˆ˜ ((π”Š ∘CF cf_const 𝔄 𝔅 π”ž)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(4) have ObjMap_dom_rhs: 
    "π’Ÿβˆ˜ (cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  show "(π”Š ∘CF cf_const 𝔄 𝔅 π”ž)⦇ObjMap⦈ = cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ObjMap⦈"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix a assume "a ∈∘ 𝔄⦇Obj⦈"
    with assms(4) show "(π”Š ∘CF cf_const 𝔄 𝔅 π”ž)⦇ObjMapβ¦ˆβ¦‡a⦈ =
      cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ObjMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto intro: assms(4) cat_cs_intros)
  from assms(4) have ArrMap_dom_lhs: 
    "π’Ÿβˆ˜ ((π”Š ∘CF cf_const 𝔄 𝔅 π”ž)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(4) have ArrMap_dom_rhs: 
    "π’Ÿβˆ˜ (cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show
    "(π”Š ∘CF cf_const 𝔄 𝔅 π”ž)⦇ArrMap⦈ = cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix a assume "a ∈∘ 𝔄⦇Arr⦈"
    with assms(4) show "(π”Š ∘CF cf_const 𝔄 𝔅 π”ž)⦇ArrMapβ¦ˆβ¦‡a⦈ =
      cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ArrMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto intro: assms(4) cat_cs_intros)

qed simp_all

lemma cf_ntcf_comp_ntcf_vcomp: 
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "π”Ž ∘CF-NTCF (𝔐 βˆ™NTCF 𝔑) = (π”Ž ∘CF-NTCF 𝔐) βˆ™NTCF (π”Ž ∘CF-NTCF 𝔑)"
proof-
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(3))
  show "π”Ž ∘CF-NTCF (𝔐 βˆ™NTCF 𝔑) = π”Ž ∘CF-NTCF 𝔐 βˆ™NTCF (π”Ž ∘CF-NTCF 𝔑)"
    by (rule ntcf_ntsmcf_eqI)
      (
        use assms in
          β€Ή
            cs_concl
              cs_simp: smc_cs_simps slicing_commute[symmetric]
              cs_intro:
                cat_cs_intros
                slicing_intros
                smcf_ntsmcf_comp_ntsmcf_vcomp
          β€Ί
      )+
qed



subsectionβ€ΉConstant natural transformationβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III in \cite{mac_lane_categories_2010}.β€Ί

definition ntcf_const :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcf_const 𝔍 β„­ f = 
    [
      vconst_on (𝔍⦇Obj⦈) f, 
      cf_const 𝔍 β„­ (ℭ⦇Domβ¦ˆβ¦‡f⦈), 
      cf_const 𝔍 β„­ (ℭ⦇Codβ¦ˆβ¦‡f⦈), 
      𝔍, 
      β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_const_components:
  shows "ntcf_const 𝔍 β„­ f⦇NTMap⦈ = vconst_on (𝔍⦇Obj⦈) f"
    and "ntcf_const 𝔍 β„­ f⦇NTDom⦈ = cf_const 𝔍 β„­ (ℭ⦇Domβ¦ˆβ¦‡f⦈)"
    and "ntcf_const 𝔍 β„­ f⦇NTCod⦈ = cf_const 𝔍 β„­ (ℭ⦇Codβ¦ˆβ¦‡f⦈)"
    and "ntcf_const 𝔍 β„­ f⦇NTDGDom⦈ = 𝔍"
    and "ntcf_const 𝔍 β„­ f⦇NTDGCod⦈ = β„­"
  unfolding ntcf_const_def nt_field_simps by (auto simp: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda ntcf_const_components(1)[folded VLambda_vconst_on]
  |vsv ntcf_const_ObjMap_vsv[cat_cs_intros]|
  |vdomain ntcf_const_ObjMap_vdomain[cat_cs_simps]|
  |app ntcf_const_ObjMap_app[cat_cs_simps]|

lemma ntcf_const_NTMap_ne_vrange: 
  assumes "𝔍⦇Obj⦈ β‰  0"
  shows "β„›βˆ˜ (ntcf_const 𝔍 β„­ f⦇NTMap⦈) = set {f}"
  using assms unfolding ntcf_const_components by simp

lemma ntcf_const_NTMap_vempty_vrange: 
  assumes "𝔍⦇Obj⦈ = 0"
  shows "β„›βˆ˜ (ntcf_const 𝔍 β„­ f⦇NTMap⦈) = 0"
  using assms unfolding ntcf_const_components by simp


subsubsectionβ€ΉConstant natural transformation is a natural transformationβ€Ί

lemma ntcf_const_is_ntcf:
  assumes "category Ξ± 𝔍" and "category Ξ± β„­" and "f : a ↦ℭ b"
  shows "ntcf_const 𝔍 β„­ f : cf_const 𝔍 β„­ a ↦CF cf_const 𝔍 β„­ b : 𝔍 ↦↦CΞ± β„­"
proof-
  interpret 𝔍: category Ξ± 𝔍 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))
  show ?thesis  
  proof(intro is_ntcfI')
    show "vfsequence (ntcf_const 𝔍 β„­ f)" unfolding ntcf_const_def by auto
    show "cf_const 𝔍 β„­ a : 𝔍 ↦↦CΞ± β„­"
    proof(rule cf_const_is_functor)
      from assms(3) show "a ∈∘ ℭ⦇Obj⦈" by (simp add: cat_cs_intros)
    qed (auto simp: cat_cs_intros)
    from assms(3) show const_b_is_functor: 
      "cf_const 𝔍 β„­ b : 𝔍 ↦↦CΞ± β„­"
      by (auto intro: cf_const_is_functor cat_cs_intros)
    show "vcard (ntcf_const 𝔍 β„­ f) = 5β„•"
      unfolding ntcf_const_def by (simp add: nat_omega_simps)
    show 
      "ntcf_const 𝔍 β„­ f⦇NTMapβ¦ˆβ¦‡a'⦈ : 
        cf_const 𝔍 β„­ a⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ cf_const 𝔍 β„­ b⦇ObjMapβ¦ˆβ¦‡a'⦈"
      if "a' ∈∘ 𝔍⦇Obj⦈" for a'
      by (simp add: that assms(3) ntcf_const_components(1) dghm_const_ObjMap_app)
    from assms(3) show 
      "ntcf_const 𝔍 β„­ f⦇NTMapβ¦ˆβ¦‡b'⦈ ∘Aβ„­ cf_const 𝔍 β„­ a⦇ArrMapβ¦ˆβ¦‡f'⦈ =
        cf_const 𝔍 β„­ b ⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘Aβ„­ ntcf_const 𝔍 β„­ f⦇NTMapβ¦ˆβ¦‡a'⦈"
      if "f' : a' ↦𝔍 b'" for f' a' b'
      using that dghm_const_ArrMap_app 
      by (auto simp: ntcf_const_components cat_cs_intros cat_cs_simps)
  qed (use assms(3) in β€Ήauto simp: ntcf_const_componentsβ€Ί)
qed 

lemma ntcf_const_is_ntcf'[cat_cs_intros]:
  assumes "category Ξ± 𝔍" 
    and "category Ξ± β„­"
    and "f : a ↦ℭ b"
    and "𝔄 = cf_const 𝔍 β„­ a"
    and "𝔅 = cf_const 𝔍 β„­ b"
    and "𝔍' = 𝔍"
    and "β„­' = β„­"
  shows "ntcf_const 𝔍 β„­ f : 𝔄 ↦CF 𝔅 : 𝔍' ↦↦CΞ± β„­'"
  using assms(1-3) unfolding assms(4-7) by (rule ntcf_const_is_ntcf)


subsubsectionβ€ΉOpposite constant natural transformationβ€Ί

lemma op_ntcf_ntcf_const[cat_op_simps]: 
  "op_ntcf (ntcf_const 𝔍 β„­ f) = ntcf_const (op_cat 𝔍) (op_cat β„­) f"
  unfolding 
    nt_field_simps dghm_field_simps dg_field_simps
    dghm_const_def ntcf_const_def op_cat_def op_cf_def op_ntcf_def 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma ntcf_const_ntcf_vcomp[cat_cs_simps]:
  assumes "category Ξ± 𝔍" 
    and "category Ξ± β„­" 
    and "g : b ↦ℭ c" 
    and "f : a ↦ℭ b"
  shows "ntcf_const 𝔍 β„­ g βˆ™NTCF ntcf_const 𝔍 β„­ f = ntcf_const 𝔍 β„­ (g ∘Aβ„­ f)"
proof-
  interpret 𝔍: category Ξ± 𝔍 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))
  from assms(3,4) have gf: "g ∘Aβ„­ f : a ↦ℭ c" by (simp add: cat_cs_intros)
  note 𝔍ℭg = ntcf_const_is_ntcf[OF assms(1,2,3)] 
    and 𝔍ℭf = ntcf_const_is_ntcf[OF assms(1,2,4)]
  show ?thesis
  proof(rule ntcf_eqI)
    from ntcf_const_is_ntcf[OF assms(1,2,3)] ntcf_const_is_ntcf[OF assms(1,2,4)]
    show 
      "ntcf_const 𝔍 β„­ g βˆ™NTCF ntcf_const 𝔍 β„­ f :
        cf_const 𝔍 β„­ a ↦CF cf_const 𝔍 β„­ c : 𝔍 ↦↦CΞ± β„­"
      by (rule ntcf_vcomp_is_ntcf)
    show
      "ntcf_const 𝔍 β„­ (g ∘Aβ„­ f) : 
        cf_const 𝔍 β„­ a ↦CF cf_const 𝔍 β„­ c : 𝔍 ↦↦CΞ± β„­"
      by (rule ntcf_const_is_ntcf[OF assms(1,2) gf])
    show "(ntcf_const 𝔍 β„­ g βˆ™NTCF ntcf_const 𝔍 β„­ f)⦇NTMap⦈ = 
      ntcf_const 𝔍 β„­ (g ∘Aβ„­ f)⦇NTMap⦈"
      unfolding ntcf_const_components
    proof(rule vsv_eqI, unfold ntcf_vcomp_NTMap_vdomain[OF 𝔍ℭf])
      fix a assume prems: "a ∈∘ 𝔍⦇Obj⦈"
      then show 
        "(ntcf_const 𝔍 β„­ g βˆ™NTCF ntcf_const 𝔍 β„­ f)⦇NTMapβ¦ˆβ¦‡a⦈ =
          vconst_on (𝔍⦇Obj⦈) (g ∘Aβ„­ f)⦇a⦈"
        unfolding ntcf_vcomp_NTMap_app[OF 𝔍ℭg 𝔍ℭf prems]  
        by (simp add: ntcf_const_components)
    qed (simp_all add: ntsmcf_vcomp_components)
  qed auto
qed

lemma ntcf_id_cf_const[cat_cs_simps]: 
  assumes "category Ξ± 𝔍" and "category Ξ± β„­" and "c ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_id (cf_const 𝔍 β„­ c) = ntcf_const 𝔍 β„­ (ℭ⦇CIdβ¦ˆβ¦‡c⦈)"
proof(rule ntcf_eqI)
  interpret 𝔍: category Ξ± 𝔍 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))
  from assms show "ntcf_const 𝔍 β„­ (ℭ⦇CIdβ¦ˆβ¦‡c⦈) : 
    cf_const 𝔍 β„­ c ↦CF cf_const 𝔍 β„­ c : 𝔍 ↦↦CΞ± β„­"
    by (auto intro: ntcf_const_is_ntcf)
  interpret const_c: is_functor Ξ± 𝔍 β„­ β€Ήcf_const 𝔍 β„­ cβ€Ί
    by (rule cf_const_is_functor) (auto simp: assms(3) cat_cs_intros)
  show "ntcf_id (cf_const 𝔍 β„­ c) : 
    cf_const 𝔍 β„­ c ↦CF cf_const 𝔍 β„­ c : 𝔍 ↦↦CΞ± β„­"
    by (rule const_c.cf_ntcf_id_is_ntcf)
  show "ntcf_id (cf_const 𝔍 β„­ c)⦇NTMap⦈ = ntcf_const 𝔍 β„­ (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold ntcf_const_components)
    show "vsv (ntcf_id (cf_const 𝔍 β„­ c)⦇NTMap⦈)"
      unfolding ntcf_id_components by (auto simp: cat_cs_simps intro: vsv_vcomp)
  qed (auto simp: cat_cs_simps)
qed simp_all

lemma ntcf_cf_comp_cf_const_right[cat_cs_simps]:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" 
    and "category Ξ± 𝔄"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝔑 ∘NTCF-CF cf_const 𝔄 𝔅 b = ntcf_const 𝔄 β„­ (𝔑⦇NTMapβ¦ˆβ¦‡b⦈)"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(2))
  show ?thesis
  proof(rule ntcf_eqI)
    from assms(3) show "𝔑 ∘NTCF-CF cf_const 𝔄 𝔅 b :
      cf_const 𝔄 β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) ↦CF cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) :
      𝔄 ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(3) show "ntcf_const 𝔄 β„­ (𝔑⦇NTMapβ¦ˆβ¦‡b⦈) :
      cf_const 𝔄 β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) ↦CF cf_const 𝔄 β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) :
      𝔄 ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(3) have dom_lhs: 
      "π’Ÿβˆ˜ ((𝔑 ∘NTCF-CF cf_const 𝔄 𝔅 b)⦇NTMap⦈) = 𝔄⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(3) have dom_rhs: 
      "π’Ÿβˆ˜ (ntcf_const 𝔄 β„­ (𝔑⦇NTMapβ¦ˆβ¦‡b⦈)⦇NTMap⦈) = 𝔄⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show 
      "(𝔑 ∘NTCF-CF cf_const 𝔄 𝔅 b)⦇NTMap⦈ = ntcf_const 𝔄 β„­ (𝔑⦇NTMapβ¦ˆβ¦‡b⦈)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔄⦇Obj⦈"
      with assms(3) show 
        "(𝔑 ∘NTCF-CF cf_const 𝔄 𝔅 b)⦇NTMapβ¦ˆβ¦‡a⦈ =
          ntcf_const 𝔄 β„­ (𝔑⦇NTMapβ¦ˆβ¦‡b⦈)⦇NTMapβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (auto intro: cat_cs_intros)
  qed simp_all
qed

lemma cf_ntcf_comp_ntcf_id[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π”Š ∘CF-NTCF ntcf_id 𝔉 = ntcf_id π”Š ∘NTCF ntcf_id 𝔉"
proof-
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1))
  interpret 𝔉: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
  proof(rule ntcf_eqI)
    show "π”Š ∘CF-NTCF ntcf_id 𝔉 : π”Š ∘CF 𝔉 ↦CF π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_cs_intros)
    show "ntcf_id π”Š ∘NTCF ntcf_id 𝔉 : π”Š ∘CF 𝔉 ↦CF π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_cs_intros)
    have dom_lhs: "π’Ÿβˆ˜ ((π”Š ∘CF-NTCF ntcf_id 𝔉)⦇NTMap⦈) = 𝔄⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    have dom_rhs: "π’Ÿβˆ˜ ((ntcf_id π”Š ∘NTCF ntcf_id 𝔉)⦇NTMap⦈) = 𝔄⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "(π”Š ∘CF-NTCF ntcf_id 𝔉)⦇NTMap⦈ = (ntcf_id π”Š ∘NTCF ntcf_id 𝔉)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔄⦇Obj⦈"
      then show 
        "(π”Š ∘CF-NTCF ntcf_id 𝔉)⦇NTMapβ¦ˆβ¦‡a⦈ =
          (ntcf_id π”Š ∘NTCF ntcf_id 𝔉)⦇NTMapβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (cs_concl cs_intro: cat_cs_intros)
  qed simp_all
qed



subsectionβ€ΉNatural isomorphismβ€Ί


textβ€ΉSee Chapter I-4 in \cite{mac_lane_categories_2010}.β€Ί

locale is_iso_ntcf = is_ntcf +
  assumes iso_ntcf_is_arr_isomorphism[cat_arrow_cs_intros]: 
    "a ∈∘ 𝔄⦇Obj⦈ ⟹ 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦iso𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"

syntax "_is_iso_ntcf" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ : _ ↦CF.iso _ : _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅" β‡Œ 
  "CONST is_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑"

lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism':
  assumes "a ∈∘ 𝔄⦇Obj⦈" 
    and "A = 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "B = π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
  shows "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : A ↦iso𝔅 B"
  using assms by (auto intro: cat_arrow_cs_intros)

lemmas [cat_arrow_cs_intros] = 
  is_iso_ntcf.iso_ntcf_is_arr_isomorphism'

lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism'':
  assumes "a ∈∘ 𝔄⦇Obj⦈" 
    and "A = 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "B = π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
    and "F = 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
    and "𝔅' = 𝔅"
  shows "F : A ↦iso𝔅' B"
  using assms by (auto intro: cat_arrow_cs_intros)


textβ€ΉRules.β€Ί

lemma (in is_iso_ntcf) is_iso_ntcf_axioms'[cat_cs_intros]: 
  assumes "Ξ±' = Ξ±" and "𝔉' = 𝔉" and "π”Š' = π”Š" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔑 : 𝔉' ↦CF.iso π”Š' : 𝔄' ↦↦CΞ±' 𝔅'"
  unfolding assms by (rule is_iso_ntcf_axioms)

mk_ide rf is_iso_ntcf_def[unfolded is_iso_ntcf_axioms_def]
  |intro is_iso_ntcfI|
  |dest is_iso_ntcfD[dest]|
  |elim is_iso_ntcfE[elim]|

lemmas [ntcf_cs_intros] = is_iso_ntcfD(1)



subsectionβ€ΉInverse natural transformationβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition inv_ntcf :: "V β‡’ V"
  where "inv_ntcf 𝔑 =
    [
      (Ξ»aβˆˆβˆ˜π”‘β¦‡NTDGDomβ¦ˆβ¦‡Obj⦈. SOME g. is_inverse (𝔑⦇NTDGCod⦈) g (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)),
      𝔑⦇NTCod⦈,
      𝔑⦇NTDom⦈,
      𝔑⦇NTDGDom⦈,
      𝔑⦇NTDGCod⦈
    ]∘"


textβ€ΉSlicing.β€Ί

lemma inv_ntcf_components:
  shows "inv_ntcf 𝔑⦇NTMap⦈ = 
    (Ξ»aβˆˆβˆ˜π”‘β¦‡NTDGDomβ¦ˆβ¦‡Obj⦈. SOME g. is_inverse (𝔑⦇NTDGCod⦈) g (𝔑⦇NTMapβ¦ˆβ¦‡a⦈))" 
    and [cat_cs_simps]: "inv_ntcf 𝔑⦇NTDom⦈ = 𝔑⦇NTCod⦈" 
    and [cat_cs_simps]: "inv_ntcf 𝔑⦇NTCod⦈ = 𝔑⦇NTDom⦈"
    and [cat_cs_simps]: "inv_ntcf 𝔑⦇NTDGDom⦈ = 𝔑⦇NTDGDom⦈" 
    and [cat_cs_simps]: "inv_ntcf 𝔑⦇NTDGCod⦈ = 𝔑⦇NTDGCod⦈" 
  unfolding inv_ntcf_def nt_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉComponents.β€Ί

lemma (in is_iso_ntcf) is_iso_ntcf_inv_ntcf_components[cat_cs_simps]: 
  "inv_ntcf 𝔑⦇NTDom⦈ = π”Š"
  "inv_ntcf 𝔑⦇NTCod⦈ = 𝔉"
  "inv_ntcf 𝔑⦇NTDGDom⦈ = 𝔄"
  "inv_ntcf 𝔑⦇NTDGCod⦈ = 𝔅"
  unfolding inv_ntcf_components by (simp_all add: cat_cs_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma inv_ntcf_NTMap_vsv[cat_cs_intros]: "vsv (inv_ntcf 𝔑⦇NTMap⦈)"
  unfolding inv_ntcf_components by auto

lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_inverse[cat_cs_intros]:
  assumes "a ∈∘ 𝔄⦇Obj⦈"
  shows "is_inverse 𝔅 (inv_ntcf 𝔑⦇NTMapβ¦ˆβ¦‡a⦈) (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)"
proof-
  from assms is_iso_ntcf_axioms have "βˆƒg. is_inverse 𝔅 g (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)" by auto
  from assms someI2_ex[OF this] show 
    "is_inverse 𝔅 (inv_ntcf 𝔑⦇NTMapβ¦ˆβ¦‡a⦈) (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)"
    unfolding inv_ntcf_components by (simp add: cat_cs_simps)
qed

lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse[cat_cs_intros]:
  assumes "a ∈∘ 𝔄⦇Obj⦈"
  shows "inv_ntcf 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ = (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)Β―C𝔅"
proof- 
  have "is_inverse 𝔅 (inv_ntcf 𝔑⦇NTMapβ¦ˆβ¦‡a⦈) (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)"
    by (rule iso_ntcf_inv_ntcf_NTMap_app_is_inverse[OF assms])
  from NTDom.HomCod.cat_is_inverse_eq_the_inverse[OF this] show ?thesis .
qed

lemmas [cat_cs_simps] = is_iso_ntcf.iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse

lemma (in is_ntcf) inv_ntcf_NTMap_vdomain[cat_cs_simps]: 
  "π’Ÿβˆ˜ (inv_ntcf 𝔑⦇NTMap⦈) = 𝔄⦇Obj⦈"
  unfolding inv_ntcf_components by (simp add: cat_cs_simps)

lemmas [cat_cs_simps] = is_ntcf.inv_ntcf_NTMap_vdomain

lemma (in is_iso_ntcf) inv_ntcf_NTMap_vrange: 
  "β„›βˆ˜ (inv_ntcf 𝔑⦇NTMap⦈) βŠ†βˆ˜ 𝔅⦇Arr⦈"
proof(rule vsubsetI)
  interpret inv_𝔑: vsv β€Ήinv_ntcf 𝔑⦇NTMapβ¦ˆβ€Ί by (rule inv_ntcf_NTMap_vsv)
  fix f assume "f ∈∘ β„›βˆ˜ (inv_ntcf 𝔑⦇NTMap⦈)"
  then obtain a 
    where f_def: "f = inv_ntcf 𝔑⦇NTMapβ¦ˆβ¦‡a⦈" and "a ∈∘ π’Ÿβˆ˜ (inv_ntcf 𝔑⦇NTMap⦈)"
    by (blast elim: inv_𝔑.vrange_atE)
  then have "a ∈∘ 𝔄⦇Obj⦈" by (simp add: cat_cs_simps)
  then have "is_inverse 𝔅 f (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)" 
    unfolding f_def by (intro iso_ntcf_inv_ntcf_NTMap_app_is_inverse)    
  then show "f ∈∘ 𝔅⦇Arr⦈" by auto
qed


subsubsectionβ€ΉOpposite natural isomorphismβ€Ί

lemma (in is_iso_ntcf) is_iso_ntcf_op: 
  "op_ntcf 𝔑 : op_cf π”Š ↦CF.iso op_cf 𝔉 : op_cat 𝔄 ↦↦CΞ± op_cat 𝔅"
proof-
  from is_iso_ntcf_axioms have 
    "op_ntcf 𝔑 : op_cf π”Š ↦CF op_cf 𝔉 : op_cat 𝔄 ↦↦CΞ± op_cat 𝔅"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  then show ?thesis 
    by (intro is_iso_ntcfI) (auto simp: cat_op_simps cat_arrow_cs_intros)
qed

lemma (in is_iso_ntcf) is_iso_ntcf_op'[cat_op_intros]:
  assumes "π”Š' = op_cf π”Š"
    and "𝔉' = op_cf 𝔉"
    and "𝔄' = op_cat 𝔄"
    and "𝔅' = op_cat 𝔅"
  shows "op_ntcf 𝔑 : π”Š' ↦CF.iso 𝔉' : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms by (rule is_iso_ntcf_op)

lemmas is_iso_ntcf_op[cat_op_intros] = is_iso_ntcf.is_iso_ntcf_op



subsectionβ€ΉA natural isomorphism is an isomorphism in the category β€ΉFunctβ€Ίβ€Ί

textβ€Ή
The results that are presented in this subsection can be found in 
nLab (see \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/natural+isomorphism
}}).
β€Ί

lemma is_arr_isomorphism_is_iso_ntcf:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔐 : π”Š ↦CF 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑 βˆ™NTCF 𝔐 = ntcf_id π”Š"
    and "𝔐 βˆ™NTCF 𝔑 = ntcf_id 𝔉"
  shows "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 𝔐 by (rule assms(2))
  show ?thesis
  proof(rule is_iso_ntcfI)
    fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈" 
    show "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦iso𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
    proof(rule is_arr_isomorphismI)
      show "is_inverse 𝔅 (𝔐⦇NTMapβ¦ˆβ¦‡a⦈) (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)"  
      proof(rule is_inverseI)
        from prems have 
          "𝔐⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ = (𝔐 βˆ™NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈"
          by (simp add: ntcf_vcomp_NTMap_app[OF assms(2,1) prems])
        also have "… = ntcf_id 𝔉⦇NTMapβ¦ˆβ¦‡a⦈" unfolding assms(4) by simp
        also from prems 𝔑.NTDom.ntcf_id_NTMap_app_vdomain have 
          "… = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
          unfolding ntcf_id_components by auto
        finally show "𝔐⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈⦈".
        from prems have 
          "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 𝔐⦇NTMapβ¦ˆβ¦‡a⦈ = (𝔑 βˆ™NTCF 𝔐)⦇NTMapβ¦ˆβ¦‡a⦈"
          by (simp add: ntcf_vcomp_NTMap_app[OF assms(1,2) prems])
        also have "… = ntcf_id π”Šβ¦‡NTMapβ¦ˆβ¦‡a⦈" unfolding assms(3) by simp
        also from prems 𝔑.NTCod.ntcf_id_NTMap_app_vdomain have 
          "… = 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
          unfolding ntcf_id_components by auto
        finally show "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 𝔐⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈⦈".
      qed (auto simp: prems cat_cs_intros)
    qed (auto simp: prems cat_cs_intros)
  qed (auto simp: cat_cs_intros)
qed

lemma iso_ntcf_is_arr_isomorphism:
  assumes "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows [ntcf_cs_intros]: "inv_ntcf 𝔑 : π”Š ↦CF.iso 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑 βˆ™NTCF inv_ntcf 𝔑 = ntcf_id π”Š"
    and "inv_ntcf 𝔑 βˆ™NTCF 𝔑 = ntcf_id 𝔉"
proof-

  interpret is_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  
  define m where "m a = inv_ntcf 𝔑⦇NTMapβ¦ˆβ¦‡a⦈" for a
  have is_inverse[intro]: "a ∈∘ 𝔄⦇Obj⦈ ⟹ is_inverse 𝔅 (m a) (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)" 
    for a
    unfolding m_def by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  have [dest, intro, simp]: 
    "a ∈∘ 𝔄⦇Obj⦈ ⟹ m a : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦iso𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈" for a
  proof-
    assume prems: "a ∈∘ 𝔄⦇Obj⦈" 
    from prems have "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦iso𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈" 
      by (auto intro: cat_cs_intros cat_arrow_cs_intros)
    with is_inverse[OF prems] show "m a : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦iso𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      by 
        (
          meson 
            NTDom.HomCod.cat_is_inverse_is_arr_isomorphism is_arr_isomorphismD
        )
  qed
  have [intro]: 
    "f : a ↦𝔄 b ⟹ m b ∘A𝔅 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 m a"
    for f a b
  proof-
    assume prems: "f : a ↦𝔄 b"
    then have ma: "m a : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦iso𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈" 
      and mb: "m b : π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈ ↦iso𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
      and π”Šf: "π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈" 
      and 𝔑a: "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
      and 𝔉f: "𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
      and 𝔑b: "𝔑⦇NTMapβ¦ˆβ¦‡b⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      by (auto intro: cat_cs_intros)
    then have 𝔑b𝔉f: 
      "𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      by (auto intro: cat_cs_intros)
    from prems have inv_ma: "is_inverse 𝔅 (m a) (𝔑⦇NTMapβ¦ˆβ¦‡a⦈)" 
      and inv_mb: "is_inverse 𝔅 (𝔑⦇NTMapβ¦ˆβ¦‡b⦈) (m b)"
      by (auto simp: is_inverse_sym)
    from mb have mb_𝔑b: "m b ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡b⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡b⦈⦈"
      by (auto intro: is_inverse_Comp_CId_right[OF inv_mb])
    from prems have 𝔑a_ma: "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 m a = 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈⦈" 
      using 𝔑a inv_ma ma by (meson is_inverse_Comp_CId_right)
    from π”Šf have "m b ∘A𝔅 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ = 
      m b ∘A𝔅 (π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 (𝔑⦇NTMapβ¦ˆβ¦‡a⦈ ∘A𝔅 m a))"
      unfolding 𝔑a_ma by (cs_concl cs_simp: cat_cs_simps)
    also have "… = m b ∘A𝔅 ((π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡a⦈) ∘A𝔅 m a)"
      by 
         (
          metis 
            ma π”Šf 𝔑a NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
        )
    also from prems have 
      "… = m b ∘A𝔅 ((𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈) ∘A𝔅 m a)"
      by (metis ntcf_Comp_commute)
    also have "… = (m b ∘A𝔅 (𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈)) ∘A𝔅 m a"
      by 
        (
          metis 
            𝔑b𝔉f ma mb NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
        )
    also from 𝔉f 𝔑b mb NTDom.HomCod.cat_Comp_assoc have 
      "… =  ((m b ∘A𝔅 𝔑⦇NTMapβ¦ˆβ¦‡b⦈) ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈) ∘A𝔅 m a"
      by (metis is_arr_isomorphismD(1))
    also from 𝔉f have "… = 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 m a" 
      unfolding mb_𝔑b by (simp add: cat_cs_simps)
    finally show "m b ∘A𝔅 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 m a" by simp
  qed

  show 𝔐: "inv_ntcf 𝔑 : π”Š ↦CF.iso 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  proof(intro is_iso_ntcfI is_ntcfI', unfold m_def[symmetric])
    show "vfsequence (inv_ntcf 𝔑)" unfolding inv_ntcf_def by simp
    show "vcard (inv_ntcf 𝔑) = 5β„•"
      unfolding inv_ntcf_def by (simp add: nat_omega_simps)
  qed (auto simp: cat_cs_simps intro: cat_cs_intros)

  interpret 𝔐: is_iso_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 β€Ήinv_ntcf 𝔑› by (rule 𝔐)

  show 𝔑𝔐: "𝔑 βˆ™NTCF inv_ntcf 𝔑 = ntcf_id π”Š"
  proof(rule ntcf_eqI)
    from NTCod.cf_ntcf_id_is_ntcf show "ntcf_id π”Š : π”Š ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
      by auto
    show "(𝔑 βˆ™NTCF inv_ntcf 𝔑)⦇NTMap⦈ = ntcf_id π”Šβ¦‡NTMap⦈"
    proof(rule vsv_eqI)
      fix a assume "a ∈∘ π’Ÿβˆ˜ ((𝔑 βˆ™NTCF inv_ntcf 𝔑)⦇NTMap⦈)"
      then have "a ∈∘ 𝔄⦇Obj⦈"
        unfolding ntcf_vcomp_NTMap_vdomain[OF 𝔐.is_ntcf_axioms] by simp
      then show "(𝔑 βˆ™NTCF inv_ntcf 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈ = ntcf_id π”Šβ¦‡NTMapβ¦ˆβ¦‡a⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_arrow_cs_intros
          )
    qed 
      (
        auto 
          simp: ntsmcf_vcomp_components(1) cat_cs_simps 
          intro: cat_cs_intros
      )
  qed (auto intro: cat_cs_intros)
    
  show 𝔐𝔑: "inv_ntcf 𝔑 βˆ™NTCF 𝔑 = ntcf_id 𝔉"
  proof(rule ntcf_eqI)
    show "(inv_ntcf 𝔑 βˆ™NTCF 𝔑)⦇NTMap⦈ = ntcf_id 𝔉⦇NTMap⦈"
    proof(rule vsv_eqI)
      show "π’Ÿβˆ˜ ((inv_ntcf 𝔑 βˆ™NTCF 𝔑)⦇NTMap⦈) = π’Ÿβˆ˜ (ntcf_id 𝔉⦇NTMap⦈)" 
        by (simp add: ntsmcf_vcomp_components(1) cat_cs_simps)
      fix a assume "a ∈∘ π’Ÿβˆ˜ ((inv_ntcf 𝔑 βˆ™NTCF 𝔑)⦇NTMap⦈)"
      then have "a ∈∘ 𝔄⦇Obj⦈" 
        unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)    
      then show "(inv_ntcf 𝔑 βˆ™NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈ = ntcf_id 𝔉⦇NTMapβ¦ˆβ¦‡a⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_arrow_cs_intros
          )
    qed 
      (
        auto simp: 
          ntsmcf_vcomp_components(1) 
          ntcf_id_components(1) 
          cat_cs_simps 
          intro: vsv_vcomp
      )
  qed (auto intro: cat_cs_intros)
qed


subsubsectionβ€ΉVertical composition of natural isomorphismsβ€Ί

lemma ntcf_vcomp_is_iso_ntcf[cat_cs_intros]:
  assumes "𝔐 : π”Š ↦CF.iso β„Œ : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔐 βˆ™NTCF 𝔑 : 𝔉 ↦CF.iso β„Œ : 𝔄 ↦↦CΞ± 𝔅"
proof(intro is_arr_isomorphism_is_iso_ntcf)
  note inv_ntcf_𝔐 = iso_ntcf_is_arr_isomorphism[OF assms(1)]
    and inv_ntcf_𝔑 = iso_ntcf_is_arr_isomorphism[OF assms(2)]
  note [cat_cs_simps] = inv_ntcf_𝔐(2,3) inv_ntcf_𝔑(2,3)
  from assms show "𝔐 βˆ™NTCF 𝔑 : 𝔉 ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
  from inv_ntcf_𝔐(1) inv_ntcf_𝔑(1) show 
    "inv_ntcf 𝔑 βˆ™NTCF inv_ntcf 𝔐 : β„Œ ↦CF 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
  from assms inv_ntcf_𝔐(1) inv_ntcf_𝔑(1) have 
    "𝔐 βˆ™NTCF 𝔑 βˆ™NTCF (inv_ntcf 𝔑 βˆ™NTCF inv_ntcf 𝔐) = 
      𝔐 βˆ™NTCF (𝔑 βˆ™NTCF inv_ntcf 𝔑) βˆ™NTCF inv_ntcf 𝔐"
    by 
      (
        cs_concl
          cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
      )
  also from assms have "… = ntcf_id β„Œ"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
  finally show "𝔐 βˆ™NTCF 𝔑 βˆ™NTCF (inv_ntcf 𝔑 βˆ™NTCF inv_ntcf 𝔐) = ntcf_id β„Œ"
    by simp
  from assms inv_ntcf_𝔐(1) inv_ntcf_𝔑(1) have 
    "inv_ntcf 𝔑 βˆ™NTCF inv_ntcf 𝔐 βˆ™NTCF (𝔐 βˆ™NTCF 𝔑) = 
      inv_ntcf 𝔑 βˆ™NTCF (inv_ntcf 𝔐 βˆ™NTCF 𝔐) βˆ™NTCF 𝔑"
    by 
      (
        cs_concl 
          cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
      )
  also from assms have "… = ntcf_id 𝔉"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
  finally show "inv_ntcf 𝔑 βˆ™NTCF inv_ntcf 𝔐 βˆ™NTCF (𝔐 βˆ™NTCF 𝔑) = ntcf_id 𝔉"
    by simp
qed


subsubsectionβ€ΉHorizontal composition of natural isomorphismsβ€Ί

lemma ntcf_hcomp_is_iso_ntcf:
  assumes "𝔐 : 𝔉' ↦CF.iso π”Š' : 𝔅 ↦↦CΞ± β„­" 
    and "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔐 ∘NTCF 𝔑 : 𝔉' ∘CF 𝔉 ↦CF.iso π”Š' ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
proof(intro is_arr_isomorphism_is_iso_ntcf)
  note inv_ntcf_𝔐 = iso_ntcf_is_arr_isomorphism[OF assms(1)]
    and inv_ntcf_𝔑 = iso_ntcf_is_arr_isomorphism[OF assms(2)]
  note [cat_cs_simps] = inv_ntcf_𝔐(2,3) inv_ntcf_𝔑(2,3)
  from assms show "𝔐 ∘NTCF 𝔑 : 𝔉' ∘CF 𝔉 ↦CF π”Š' ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
  from inv_ntcf_𝔐(1) inv_ntcf_𝔑(1) show 
    "inv_ntcf 𝔐 ∘NTCF inv_ntcf 𝔑 : π”Š' ∘CF π”Š ↦CF 𝔉' ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
  from assms inv_ntcf_𝔐(1) inv_ntcf_𝔑(1) have 
    "𝔐 ∘NTCF 𝔑 βˆ™NTCF (inv_ntcf 𝔐 ∘NTCF inv_ntcf 𝔑) = 
      ntcf_id π”Š' ∘NTCF ntcf_id π”Š"
    by 
      (
        cs_concl 
          cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps 
          cs_intro: ntcf_cs_intros
      )
  also from assms have "… = ntcf_id (π”Š' ∘CF π”Š)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
  finally show 
    "𝔐 ∘NTCF 𝔑 βˆ™NTCF (inv_ntcf 𝔐 ∘NTCF inv_ntcf 𝔑) = ntcf_id (π”Š' ∘CF π”Š)"
    by simp
  from assms inv_ntcf_𝔐(1) inv_ntcf_𝔑(1) have 
    "inv_ntcf 𝔐 ∘NTCF inv_ntcf 𝔑 βˆ™NTCF (𝔐 ∘NTCF 𝔑) = 
      ntcf_id 𝔉' ∘NTCF ntcf_id 𝔉"
    by 
      (
        cs_concl 
          cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps
          cs_intro: ntcf_cs_intros
      )
  also from assms have "… = ntcf_id (𝔉' ∘CF 𝔉)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
  finally show 
    "inv_ntcf 𝔐 ∘NTCF inv_ntcf 𝔑 βˆ™NTCF (𝔐 ∘NTCF 𝔑) = ntcf_id (𝔉' ∘CF 𝔉)"
    by simp
qed

lemma ntcf_hcomp_is_iso_ntcf'[ntcf_cs_intros]:
  assumes "𝔐 : 𝔉' ↦CF.iso π”Š' : 𝔅 ↦↦CΞ± β„­" 
    and "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "β„Œ' = 𝔉' ∘CF 𝔉"
    and "β„Œ'' = π”Š' ∘CF π”Š"
  shows "𝔐 ∘NTCF 𝔑 : β„Œ' ↦CF.iso β„Œ'' : 𝔄 ↦↦CΞ± β„­"
  using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_iso_ntcf)


subsubsectionβ€ΉAn identity natural transformation is a natural isomorphismβ€Ί

lemma (in is_functor) cf_ntcf_id_is_iso_ntcf:
  "ntcf_id 𝔉 : 𝔉 ↦CF.iso 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
proof-
  have "ntcf_id 𝔉 : 𝔉 ↦CF 𝔉 : 𝔄 ↦↦CΞ± 𝔅" by (auto intro: cat_cs_intros)
  moreover then have "ntcf_id 𝔉 βˆ™NTCF ntcf_id 𝔉 = ntcf_id 𝔉" 
    by (cs_concl cs_simp: cat_cs_simps)
  ultimately show ?thesis by (auto intro: is_arr_isomorphism_is_iso_ntcf)
qed

lemma (in is_functor) cf_ntcf_id_is_iso_ntcf'[ntcf_cs_intros]:
  assumes "π”Š' = 𝔉" and "β„Œ' = 𝔉"
  shows "ntcf_id 𝔉 : π”Š' ↦CF.iso β„Œ' : 𝔄 ↦↦CΞ± 𝔅"
  unfolding assms by (rule cf_ntcf_id_is_iso_ntcf)

lemmas [ntcf_cs_intros] = is_functor.cf_ntcf_id_is_iso_ntcf'



subsectionβ€ΉFunctor isomorphismβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee subsection 1.5 in \cite{bodo_categories_1970}.β€Ί

locale iso_functor =
  fixes Ξ± 𝔉 π”Š
  assumes iso_cf_is_iso_ntcf: "βˆƒπ”„ 𝔅 𝔑. 𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"

notation iso_functor (infixl "β‰ˆCFΔ±" 50)


textβ€ΉRules.β€Ί

lemma iso_functorI:
  assumes "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔉 β‰ˆCFΞ± π”Š"
  using assms unfolding iso_functor_def by auto

lemma iso_functorD[dest]:
  assumes "𝔉 β‰ˆCFΞ± π”Š"
  shows "βˆƒπ”„ 𝔅 𝔑. 𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
  using assms unfolding iso_functor_def by auto

lemma iso_functorE[elim]:
  assumes "𝔉 β‰ˆCFΞ± π”Š"
  obtains 𝔄 𝔅 𝔑 where "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
  using assms unfolding iso_functor_def by auto


subsubsectionβ€ΉA functor isomorphism is an equivalence relationβ€Ί

lemma iso_functor_refl: 
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔉 β‰ˆCFΞ± 𝔉"
proof(rule iso_functorI)
  from assms show "ntcf_id 𝔉 : 𝔉 ↦CF.iso 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: ntcf_cs_intros)
qed

lemma iso_functor_sym[sym]:
  assumes "𝔉 β‰ˆCFΞ± π”Š"
  shows "π”Š β‰ˆCFΞ± 𝔉"
proof-
  from assms obtain 𝔄 𝔅 𝔑 where 𝔑: "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅" by auto
  from iso_ntcf_is_arr_isomorphism(1)[OF 𝔑] show "π”Š β‰ˆCFΞ± 𝔉" 
    by (auto simp: iso_functorI)
qed

lemma iso_functor_trans[trans, intro]:
  assumes "𝔉 β‰ˆCFΞ± π”Š" and "π”Š β‰ˆCFΞ± β„Œ"
  shows "𝔉 β‰ˆCFΞ± β„Œ"
proof-
  from assms(1) obtain 𝔄 𝔅 𝔑 where 𝔑: "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    by auto
  moreover from assms(2) obtain 𝔄' 𝔅' 𝔐
    where 𝔐: "𝔐 : π”Š ↦CF.iso β„Œ : 𝔄' ↦↦CΞ± 𝔅'" 
    by auto
  ultimately have "π”Š : 𝔄' ↦↦CΞ± 𝔅'" and "π”Š : 𝔄 ↦↦CΞ± 𝔅" by blast+
  then have eq: "𝔄' = 𝔄" "𝔅' = 𝔅" by auto
  from 𝔐 have 𝔐: "𝔐 : π”Š ↦CF.iso β„Œ : 𝔄 ↦↦CΞ± 𝔅" unfolding eq .
  from ntcf_vcomp_is_iso_ntcf[OF 𝔐 𝔑] show ?thesis by (rule iso_functorI)
qed


subsubsectionβ€ΉOpposite functor isomorphismβ€Ί

lemma (in iso_functor) iso_functor_op: "op_cf 𝔉 β‰ˆCFΞ± op_cf π”Š"
proof-
  from iso_functor_axioms obtain 𝔄 𝔅 𝔑 where "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  from is_iso_ntcf_op[OF this] have "op_cf π”Š β‰ˆCFΞ± op_cf 𝔉" 
    by (auto simp: iso_functorI)
  then show "op_cf 𝔉 β‰ˆCFΞ± op_cf π”Š" by (rule iso_functor_sym)
qed

lemmas iso_functor_op[cat_op_intros] = iso_functor.iso_functor_op

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Small_NTCF

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉSmallness for natural transformationsβ€Ί
theory CZH_ECAT_Small_NTCF
  imports 
    CZH_Foundations.CZH_SMC_Small_NTSMCF
    CZH_ECAT_Small_Functor
    CZH_ECAT_NTCF
begin



subsectionβ€ΉNatural transformation of functors with tiny mapsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale is_tm_ntcf = is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 for Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 +
  assumes tm_ntcf_is_tm_ntsmcf: "ntcf_ntsmcf 𝔑 :
    cf_smcf 𝔉 ↦SMCF.tm cf_smcf π”Š : cat_smc 𝔄 ↦↦SMC.tmΞ± cat_smc 𝔅"

syntax "_is_tm_ntcf" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦CF.tm _ :/ _ ↦↦C.tmΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅" β‡Œ
  "CONST is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑"

abbreviation all_tm_ntcfs :: "V β‡’ V"
  where "all_tm_ntcfs Ξ± ≑
    set {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"

abbreviation tm_ntcfs :: "V β‡’ V β‡’ V β‡’ V"
  where "tm_ntcfs Ξ± 𝔄 𝔅 ≑
    set {𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"

abbreviation these_tm_ntcfs :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "these_tm_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š ≑
    set {𝔑. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"

lemma (in is_tm_ntcf) tm_ntcf_is_tm_ntsmcf':
  assumes "𝔉' = cf_smcf 𝔉"
    and "π”Š' = cf_smcf π”Š"
    and "𝔄' = cat_smc 𝔄"
    and "𝔅' = cat_smc 𝔅"
  shows "ntcf_ntsmcf 𝔑 : 𝔉' ↦SMCF.tm π”Š' : 𝔄' ↦↦SMC.tmΞ± 𝔅'"
  unfolding assms by (rule tm_ntcf_is_tm_ntsmcf)

lemmas [slicing_intros] = is_tm_ntcf.tm_ntcf_is_tm_ntsmcf'


textβ€ΉRules.β€Ί

lemma (in is_tm_ntcf) is_tm_ntcf_axioms'[cat_small_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅" and "𝔉' = 𝔉" and "π”Š' = π”Š"
  shows "𝔑 : 𝔉' ↦CF.tm π”Š' : 𝔄' ↦↦C.tmΞ± 𝔅'"
  unfolding assms by (rule is_tm_ntcf_axioms)

mk_ide rf is_tm_ntcf_def[unfolded is_tm_ntcf_axioms_def]
  |intro is_tm_ntcfI|
  |dest is_tm_ntcfD[dest]|
  |elim is_tm_ntcfE[elim]|

lemmas [cat_small_cs_intros] = is_tm_ntcfD(1)

context is_tm_ntcf
begin

interpretation ntsmcf: is_tm_ntsmcf
  Ξ± β€Ήcat_smc 𝔄› β€Ήcat_smc 𝔅› β€Ήcf_smcf 𝔉› β€Ήcf_smcf π”Šβ€Ί β€Ήntcf_ntsmcf 𝔑›
  by (rule tm_ntcf_is_tm_ntsmcf)

lemmas_with [unfolded slicing_simps]:
  tm_ntcf_NTMap_in_Vset = ntsmcf.tm_ntsmcf_NTMap_in_Vset

end

sublocale is_tm_ntcf βŠ† NTDom: is_tm_functor Ξ± 𝔄 𝔅 𝔉
  using tm_ntcf_is_tm_ntsmcf 
  by (intro is_tm_functorI) (auto intro: cat_cs_intros is_tm_ntsmcfD')

sublocale is_tm_ntcf βŠ† NTCod: is_tm_functor Ξ± 𝔄 𝔅 π”Š
  using tm_ntcf_is_tm_ntsmcf 
  by (intro is_tm_functorI) (auto intro: cat_cs_intros is_tm_ntsmcfD')


textβ€ΉFurther rules.β€Ί

lemma is_tm_ntcfI':
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
proof-
  interpret is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret 𝔉: is_tm_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  interpret π”Š: is_tm_functor Ξ± 𝔄 𝔅 π”Š by (rule assms(3))
  show ?thesis
  proof(intro is_tm_ntcfI)
    show "ntcf_ntsmcf 𝔑 : 
      cf_smcf 𝔉 ↦SMCF.tm cf_smcf π”Š : cat_smc 𝔄 ↦↦SMC.tmΞ± cat_smc 𝔅"
      by (intro is_tm_ntsmcfI') (auto intro: slicing_intros)
  qed (auto intro: cat_cs_intros)
qed

lemma is_tm_ntcfD':
  assumes "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
proof-
  interpret is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  show "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
    by (auto simp: cat_small_cs_intros)
qed

lemmas [cat_small_cs_intros] = is_tm_ntcfD'(2,3)

lemma is_tm_ntcfE':
  assumes "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  obtains "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  using is_tm_ntcfD'[OF assms] by auto


textβ€ΉThe set of all natural transformations with tiny maps is small.β€Ί

lemma small_all_tm_ntcfs[simp]: 
  "small {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"
proof(rule down)
  show 
    "{𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅} βŠ†
      elts (set {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅})"
  proof
    (
      simp only: elts_of_set small_all_ntcfs if_True, 
      rule subsetI, 
      unfold mem_Collect_eq
    )
    fix 𝔑 assume "βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
    then obtain 𝔉 π”Š 𝔄 𝔅 where "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
      by clarsimp
    then interpret is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by simp
    have "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" by (auto simp: cat_cs_intros)
    then show "βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" by auto
  qed
qed

lemma small_tm_ntcfs[simp]: 
  "small {𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"
  by (rule down[of _ β€Ήset {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}β€Ί])
    auto

lemma small_these_tm_ntcfs[simp]: 
  "small {𝔑. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"
  by (rule down[of _ β€Ήset {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}β€Ί]) 
    auto


textβ€ΉFurther elementary results.β€Ί

lemma these_tm_ntcfs_iff: (*not simp*)
  "𝔑 ∈∘ these_tm_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š ⟷ 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  by auto


subsubsectionβ€ΉOpposite natural transformation of functors with tiny mapsβ€Ί

lemma (in is_tm_ntcf) is_tm_ntcf_op: "op_ntcf 𝔑 :
  op_cf π”Š ↦CF.tm op_cf 𝔉 : op_cat 𝔄 ↦↦C.tmΞ± op_cat 𝔅"
  by (intro is_tm_ntcfI')
    (cs_concl cs_intro: cat_cs_intros cat_op_intros)+

lemma (in is_tm_ntcf) is_tm_ntcf_op'[cat_op_intros]: 
  assumes "π”Š' = op_cf π”Š"
    and "𝔉' = op_cf 𝔉"
    and "𝔄' = op_cat 𝔄"
    and "𝔅' = op_cat 𝔅"
  shows "op_ntcf 𝔑 : π”Š' ↦CF.tm 𝔉' : 𝔄' ↦↦C.tmΞ± 𝔅'"
  unfolding assms by (rule is_tm_ntcf_op)

lemmas is_tm_ntcf_op[cat_op_intros] = is_tm_ntcf.is_tm_ntcf_op'


subsubsectionβ€Ή
Vertical composition of natural transformations of 
functors with tiny maps
β€Ί

lemma ntcf_vcomp_is_tm_ntcf[cat_small_cs_intros]:
  assumes "𝔐 : π”Š ↦CF.tm β„Œ : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows "𝔐 βˆ™NTCF 𝔑 : 𝔉 ↦CF.tm β„Œ : 𝔄 ↦↦C.tmΞ± 𝔅"
proof-
  interpret 𝔐: is_tm_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 by (rule assms(1))
  interpret 𝔑: is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis 
    by (rule is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros) 
qed


subsubsectionβ€ΉIdentity natural transformation of a functor with tiny mapsβ€Ί

lemma (in is_tm_functor) tm_cf_ntcf_id_is_tm_ntcf:
  "ntcf_id 𝔉 : 𝔉 ↦CF.tm 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
  by (intro is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)

lemma (in is_tm_functor) tm_cf_ntcf_id_is_tm_ntcf':
  assumes "𝔉' = 𝔉" and "π”Š' = 𝔉"
  shows "ntcf_id 𝔉 : 𝔉' ↦CF.tm π”Š': 𝔄 ↦↦C.tmΞ± 𝔅"
  unfolding assms(1,2) by (rule tm_cf_ntcf_id_is_tm_ntcf)

lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_ntcf_id_is_tm_ntcf'


subsubsectionβ€ΉConstant natural transformation of functors with tiny mapsβ€Ί

lemma ntcf_const_is_tm_ntcf:
  assumes "tiny_category Ξ± 𝔍" and "category Ξ± β„­" and "f : a ↦ℭ b"
  shows "ntcf_const 𝔍 β„­ f : 
    cf_const 𝔍 β„­ a ↦CF.tm cf_const 𝔍 β„­ b : 𝔍 ↦↦C.tmΞ± β„­"
    (is β€Ή?Cf : ?Ca ↦CF.tm ?Cb : 𝔍 ↦↦C.tmΞ± β„­β€Ί)
proof(intro is_tm_ntcfI')
  interpret 𝔍: tiny_category Ξ± 𝔍 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))
  from assms show 
    "?Cf : ?Ca ↦CF ?Cb : 𝔍 ↦↦CΞ± β„­"
    "cf_const 𝔍 β„­ a : 𝔍 ↦↦C.tmΞ± β„­"
    "cf_const 𝔍 β„­ b : 𝔍 ↦↦C.tmΞ± β„­"
    by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+
qed

lemma ntcf_const_is_tm_ntcf'[cat_small_cs_intros]:
  assumes "tiny_category Ξ± 𝔍" 
    and "category Ξ± β„­"
    and "f : a ↦ℭ b"
    and "𝔄 = cf_const 𝔍 β„­ a"
    and "𝔅 = cf_const 𝔍 β„­ b"
    and "𝔍' = 𝔍"
    and "β„­' = β„­"
  shows "ntcf_const 𝔍 β„­ f : 𝔄 ↦CF.tm 𝔅 : 𝔍' ↦↦C.tmΞ± β„­'"
  using assms(1-3) unfolding assms(4-7) by (rule ntcf_const_is_tm_ntcf)


subsubsectionβ€ΉNatural isomorphisms of functors with tiny mapsβ€Ί

locale is_tm_iso_ntcf = is_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 + is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 
  for Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑

syntax "_is_tm_iso_ntcf" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ : _ ↦CF.tm.iso _ : _ ↦↦C.tmΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 ↦CF.tm.iso π”Š : 𝔄 ↦↦C.tmΞ± 𝔅" β‡Œ
  "CONST is_tm_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑"


textβ€ΉRules.β€Ί

mk_ide rf is_tm_iso_ntcf_def
  |intro is_tm_iso_ntcfI|
  |dest is_tm_iso_ntcfD[dest]|
  |elim is_tm_iso_ntcfE[elim]|

lemmas [ntcf_cs_intros] = is_tm_iso_ntcfD

lemma iso_tm_ntcf_is_arr_isomorphism:
  assumes "category Ξ± 𝔅" and "𝔑 : 𝔉 ↦CF.tm.iso π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows [ntcf_cs_intros]: "inv_ntcf 𝔑 : π”Š ↦CF.tm.iso 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "𝔑 βˆ™NTCF inv_ntcf 𝔑 = ntcf_id π”Š"
    and "inv_ntcf 𝔑 βˆ™NTCF 𝔑 = ntcf_id 𝔉"
proof-
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(1))
  interpret 𝔑: is_tm_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms)
  note inv_𝔑 = iso_ntcf_is_arr_isomorphism[OF 𝔑.is_iso_ntcf_axioms]
  show "inv_ntcf 𝔑 : π”Š ↦CF.tm.iso 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
  proof(intro is_tm_iso_ntcfI)
    show "inv_ntcf 𝔑 : π”Š ↦CF.iso 𝔉 : 𝔄 ↦↦CΞ± 𝔅" by (intro inv_𝔑(1))
    interpret inv_𝔑: is_iso_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 β€Ήinv_ntcf 𝔑› by (rule inv_𝔑(1))
    show "inv_ntcf 𝔑 : π”Š ↦CF.tm 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
      by (intro is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)
  qed
  show "𝔑 βˆ™NTCF inv_ntcf 𝔑 = ntcf_id π”Š" "inv_ntcf 𝔑 βˆ™NTCF 𝔑 = ntcf_id 𝔉" 
    by (intro inv_𝔑(2,3))+
qed

lemma is_arr_isomorphism_is_tm_iso_ntcf:
  assumes "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "𝔐 : π”Š ↦CF.tm 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    and [simp]: "𝔑 βˆ™NTCF 𝔐 = ntcf_id π”Š"
    and [simp]: "𝔐 βˆ™NTCF 𝔑 = ntcf_id 𝔉"
  shows "𝔑 : 𝔉 ↦CF.tm.iso π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
proof-
  interpret 𝔑: is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret 𝔐: is_tm_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 𝔐 by (rule assms(2))
  show ?thesis
  proof(rule is_tm_iso_ntcfI)
    show "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
      by (rule is_arr_isomorphism_is_iso_ntcf) (auto intro: cat_small_cs_intros)
    show "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
      by (rule is_tm_ntcfI')
        (auto simp: 𝔑.tm_ntcf_NTMap_in_Vset intro: cat_small_cs_intros)
  qed
qed


subsubsectionβ€Ή
Composition of a natural transformation 
of functors with tiny maps and a functor with tiny maps
β€Ί

lemma ntcf_cf_comp_is_tm_ntcf:
  assumes "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔅 ↦↦C.tmΞ± β„­" and "β„Œ : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows "𝔑 ∘NTCF-CF β„Œ : 𝔉 ∘CF β„Œ ↦CF.tm π”Š ∘CF β„Œ : 𝔄 ↦↦C.tmΞ± β„­"
proof-
  interpret 𝔑: is_tm_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_tm_functor Ξ± 𝔄 𝔅 β„Œ by (rule assms(2))
  from assms show ?thesis
    by (intro is_tm_ntcfI)
      (
        cs_concl 
          cs_simp: slicing_commute[symmetric] 
          cs_intro: cat_cs_intros smc_small_cs_intros slicing_intros
      )+
qed

lemma ntcf_cf_comp_is_tm_ntcf'[cat_small_cs_intros]:
  assumes "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔅 ↦↦C.tmΞ± β„­" 
    and "β„Œ : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "𝔉' = 𝔉 ∘CF β„Œ"
    and "π”Š' = π”Š ∘CF β„Œ"
  shows "𝔑 ∘NTCF-CF β„Œ : 𝔉' ↦CF.tm π”Š' : 𝔄 ↦↦C.tmΞ± β„­"
  using assms(1,2) unfolding assms(3,4) by (rule ntcf_cf_comp_is_tm_ntcf)


subsubsectionβ€Ή
Composition of a functor with tiny maps 
and a natural transformation of functors with tiny maps
β€Ί

lemma cf_ntcf_comp_is_tm_ntcf:
  assumes "β„Œ : 𝔅 ↦↦C.tmΞ± β„­" and "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  shows "β„Œ ∘CF-NTCF 𝔑 : β„Œ ∘CF 𝔉 ↦CF.tm β„Œ ∘CF π”Š : 𝔄 ↦↦C.tmΞ± β„­"
proof-
  interpret β„Œ: is_tm_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(1))
  interpret 𝔑: is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  from assms show ?thesis
    by (intro is_tm_ntcfI)
      (
        cs_concl 
          cs_simp: slicing_commute[symmetric] 
          cs_intro: cat_cs_intros smc_small_cs_intros slicing_intros
      )+
qed

lemma cf_ntcf_comp_is_tm_ntcf'[cat_small_cs_intros]:
  assumes "β„Œ : 𝔅 ↦↦C.tmΞ± β„­" 
    and "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
    and "𝔉' = β„Œ ∘CF 𝔉"
    and "π”Š' = β„Œ ∘CF π”Š"
  shows "β„Œ ∘CF-NTCF 𝔑 : 𝔉' ↦CF.tm π”Š' : 𝔄 ↦↦C.tmΞ± β„­"
  using assms(1,2) unfolding assms(3,4) by (rule cf_ntcf_comp_is_tm_ntcf)



subsectionβ€ΉTiny natural transformation of functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale is_tiny_ntcf = is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 for Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 +
  assumes tiny_ntcf_is_tiny_ntsmcf: 
    "ntcf_ntsmcf 𝔑 :
      cf_smcf 𝔉 ↦SMCF.tiny cf_smcf π”Š : cat_smc 𝔄 ↦↦SMC.tinyΞ± cat_smc 𝔅"

syntax "_is_tiny_ntcf" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦CF.tiny _ :/ _ ↦↦C.tinyΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅" β‡Œ 
  "CONST is_tiny_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑"

abbreviation all_tiny_ntcfs :: "V β‡’ V"
  where "all_tiny_ntcfs Ξ± ≑
    set {𝔑. βˆƒπ”„ 𝔅 𝔉 π”Š. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}"

abbreviation tiny_ntcfs :: "V β‡’ V β‡’ V β‡’ V"
  where "tiny_ntcfs Ξ± 𝔄 𝔅 ≑
    set {𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}"

abbreviation these_tiny_ntcfs :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "these_tiny_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š ≑
    set {𝔑. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}"

lemma (in is_tiny_ntcf) tiny_ntcf_is_tiny_ntsmcf':
  assumes "Ξ±' = Ξ±"
    and "𝔉' = cf_smcf 𝔉"
    and "π”Š' = cf_smcf π”Š"
    and "𝔄' = cat_smc 𝔄"
    and "𝔅' = cat_smc 𝔅"
  shows "ntcf_ntsmcf 𝔑 : 𝔉' ↦SMCF.tiny π”Š' : 𝔄' ↦↦SMC.tinyΞ±' 𝔅'"
  unfolding assms by (rule tiny_ntcf_is_tiny_ntsmcf)

lemmas [slicing_intros] = is_tiny_ntcf.tiny_ntcf_is_tiny_ntsmcf'


textβ€ΉRules.β€Ί

lemma (in is_tiny_ntcf) is_tiny_ntcf_axioms'[cat_small_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅" and "𝔉' = 𝔉" and "π”Š' = π”Š"
  shows "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  unfolding assms by (rule is_tiny_ntcf_axioms)

mk_ide rf is_tiny_ntcf_def[unfolded is_tiny_ntcf_axioms_def]
  |intro is_tiny_ntcfI|
  |dest is_tiny_ntcfD[dest]|
  |elim is_tiny_ntcfE[elim]|


textβ€ΉElementary properties.β€Ί

sublocale is_tiny_ntcf βŠ† NTDom: is_tiny_functor Ξ± 𝔄 𝔅 𝔉 
  using tiny_ntcf_is_tiny_ntsmcf 
  by (intro is_tiny_functorI) 
    (auto intro: cat_cs_intros simp: is_tiny_ntsmcf_iff)

sublocale is_tiny_ntcf βŠ† NTCod: is_tiny_functor Ξ± 𝔄 𝔅 π”Š
  using tiny_ntcf_is_tiny_ntsmcf 
  by (intro is_tiny_functorI) 
    (auto intro: cat_cs_intros simp: is_tiny_ntsmcf_iff)

sublocale is_tiny_ntcf βŠ† is_tm_ntcf 
  by (rule is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)

lemmas (in is_tiny_ntcf) tiny_ntcf_is_tm_ntcf[cat_small_cs_intros] = 
  is_tm_ntcf_axioms

lemmas [cat_small_cs_intros] = is_tiny_ntcf.tiny_ntcf_is_tm_ntcf


textβ€ΉFurther rules.β€Ί

lemma is_tiny_ntcfI':
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
proof-
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret 𝔉: is_tiny_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  interpret π”Š: is_tiny_functor Ξ± 𝔄 𝔅 π”Š by (rule assms(3))
  show "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
    by (intro is_tiny_ntcfI is_tiny_ntsmcfI') 
      (auto intro: cat_cs_intros slicing_intros)
qed

lemma is_tiny_ntcfD':
  assumes "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
proof-
  interpret 𝔑: is_tiny_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  show "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
    by (auto intro: cat_small_cs_intros)
qed

lemmas [cat_small_cs_intros] = is_tiny_ntcfD'(2,3)

lemma is_tiny_ntcfE':
  assumes "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  obtains "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  using assms by (auto dest: is_tiny_ntcfD'(2,3))

lemma is_tiny_ntcf_iff:
  "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅 ⟷ 
    (
      𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅 ∧ 
      𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅 ∧ 
      π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅
    )"
   by (auto intro: is_tiny_ntcfI' dest: is_tiny_ntcfD'(2,3))

lemma (in is_tiny_ntcf) tiny_ntcf_in_Vset: "𝔑 ∈∘ Vset Ξ±"
proof-
  note [cat_cs_intros] =
    tm_ntcf_NTMap_in_Vset
    NTDom.tiny_cf_in_Vset
    NTCod.tiny_cf_in_Vset
    NTDom.HomDom.tiny_cat_in_Vset
    NTDom.HomCod.tiny_cat_in_Vset
  show ?thesis
    by (subst ntcf_def) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed

lemma small_all_tiny_ntcfs[simp]: 
  "small {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}"
proof(rule down)
  show "{𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅} βŠ† 
    elts (set {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅})"
  proof
    (
      simp only: elts_of_set small_all_ntcfs if_True, 
      rule subsetI, 
      unfold mem_Collect_eq
    )
    fix 𝔑 assume "βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
    then obtain 𝔉 π”Š 𝔄 𝔅 where "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
      by clarsimp
    then interpret is_tiny_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 .
    have "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" by (auto intro: cat_cs_intros)
    then show "βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" by auto
  qed
qed

lemma small_tiny_ntcfs[simp]: 
  "small {𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}"
  by 
    (
      rule 
        down[
          of _ β€Ήset {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}β€Ί
          ]
    )
    auto

lemma small_these_tiny_ntcfs[simp]: 
  "small {𝔑. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}"
  by 
    (
      rule 
        down[
          of _ β€Ήset {𝔑. βˆƒπ”‰ π”Š 𝔄 𝔅. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅}β€Ί
          ]
    ) 
    auto

lemma tiny_ntcfs_vsubset_Vset[simp]: 
  "set {𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅} βŠ†βˆ˜ Vset Ξ±"
  (is β€Ήset ?ntcfs βŠ†βˆ˜ _β€Ί)
proof(cases β€Ήtiny_category Ξ± 𝔄 ∧ tiny_category Ξ± 𝔅›)
  case True
  then have "tiny_category Ξ± 𝔄" and "tiny_category Ξ± 𝔅" by auto
  show ?thesis 
  proof(rule vsubsetI)
    fix 𝔑 assume "𝔑 ∈∘ set ?ntcfs"
    then obtain 𝔉 π”Š where "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅" by auto
    then interpret is_tiny_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by simp
    from tiny_ntcf_in_Vset show "𝔑 ∈∘ Vset Ξ±" by simp
  qed
next
  case False
  then have "set ?ntcfs = 0" 
    unfolding is_tiny_ntcf_iff is_tiny_functor_iff by auto
  then show ?thesis by simp
qed


textβ€ΉFurther elementary results.β€Ί

lemma these_tiny_ntcfs_iff: (*not simp*) 
  "𝔑 ∈∘ these_tiny_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š ⟷ 𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  by auto


textβ€ΉSize.β€Ί

lemma (in is_ntcf) ntcf_is_tiny_ntcf_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ² 𝔅" 
proof(intro is_tiny_ntcfI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ² 𝔅"
    by (intro ntcf_is_ntcf_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: dg_cs_introsβ€Ί)+
  show "ntcf_ntsmcf 𝔑 : 
    cf_smcf 𝔉 ↦SMCF.tiny cf_smcf π”Š : cat_smc 𝔄 ↦↦SMC.tinyΞ² cat_smc 𝔅"
    by 
      ( 
        rule is_ntsmcf.ntsmcf_is_tiny_ntsmcf_if_ge_Limit, 
        rule ntcf_is_ntsmcf;
        intro assms
     )
qed


subsubsectionβ€ΉOpposite natural transformation of tiny functorsβ€Ί

lemma (in is_tiny_ntcf) is_tm_ntcf_op: "op_ntcf 𝔑 :
  op_cf π”Š ↦CF.tiny op_cf 𝔉 : op_cat 𝔄 ↦↦C.tinyΞ± op_cat 𝔅"
  by (intro is_tiny_ntcfI')
   (cs_concl cs_intro: cat_cs_intros cat_op_intros)+

lemma (in is_tiny_ntcf) is_tiny_ntcf_op'[cat_op_intros]: 
  assumes "π”Š' = op_cf π”Š"
    and "𝔉' = op_cf 𝔉"
    and "𝔄' = op_cat 𝔄"
    and "𝔅' = op_cat 𝔅"
  shows "op_ntcf 𝔑 : π”Š' ↦CF.tiny 𝔉' : 𝔄' ↦↦C.tinyΞ± 𝔅'"
  unfolding assms by (rule is_tm_ntcf_op)

lemmas is_tiny_ntcf_op[cat_op_intros] = is_tiny_ntcf.is_tiny_ntcf_op'


subsubsectionβ€ΉVertical composition of tiny natural transformationsβ€Ί

lemma ntsmcf_vcomp_is_tiny_ntsmcf[cat_small_cs_intros]:
  assumes "𝔐 : π”Š ↦CF.tiny β„Œ : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows "𝔐 βˆ™NTCF 𝔑 : 𝔉 ↦CF.tiny β„Œ : 𝔄 ↦↦C.tinyΞ± 𝔅"
proof-
  interpret 𝔐: is_tiny_ntcf Ξ± 𝔄 𝔅 π”Š β„Œ 𝔐 by (rule assms(1))
  interpret 𝔑: is_tiny_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(2))
  show ?thesis by (rule is_tiny_ntcfI') (auto intro: cat_small_cs_intros)
qed


subsubsectionβ€ΉTiny identity natural transformationβ€Ί

lemma (in is_tiny_functor) tiny_cf_ntcf_id_is_tiny_ntcf:
  "ntcf_id 𝔉 : 𝔉 ↦CF.tiny 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
  by (intro is_tiny_ntcfI') (auto intro: cat_small_cs_intros)

lemma (in is_tiny_functor) tiny_cf_ntcf_id_is_tiny_ntcf'[cat_small_cs_intros]:
  assumes "𝔉' = 𝔉" and "π”Š' = 𝔉"
  shows "ntcf_id 𝔉 : 𝔉' ↦CF.tiny π”Š' : 𝔄 ↦↦C.tinyΞ± 𝔅"
  unfolding assms by (rule tiny_cf_ntcf_id_is_tiny_ntcf)

lemmas [cat_small_cs_intros] = is_tiny_functor.tiny_cf_ntcf_id_is_tiny_ntcf'



subsectionβ€ΉTiny natural isomorphismsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale is_tiny_iso_ntcf = is_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 + is_tiny_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 
  for Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑

syntax "_is_tiny_iso_ntcf" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ : _ ↦CF.tiny.iso _ : _ ↦↦C.tinyΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅" β‡Œ
  "CONST is_tiny_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑"


textβ€ΉRules.β€Ί

mk_ide rf is_tiny_iso_ntcf_def
  |intro is_tiny_iso_ntcfI|
  |dest is_tiny_iso_ntcfD[dest]|
  |elim is_tiny_iso_ntcfE[elim]|

lemmas [ntcf_cs_intros] = is_tiny_iso_ntcfD(2)


textβ€ΉElementary properties.β€Ί

sublocale is_tiny_iso_ntcf βŠ† is_tm_iso_ntcf 
  by (rule is_tm_iso_ntcfI) (auto intro: cat_cs_intros cat_small_cs_intros)

lemmas (in is_tiny_iso_ntcf) is_tm_iso_ntcf_axioms' = is_tm_iso_ntcf_axioms

lemmas [ntcf_cs_intros] = is_tiny_iso_ntcf.is_tm_iso_ntcf_axioms'


textβ€ΉFurther rules.β€Ί

lemma is_tiny_iso_ntcfI':
  assumes "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
proof-
  interpret 𝔑: is_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret 𝔉: is_tiny_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  interpret π”Š: is_tiny_functor Ξ± 𝔄 𝔅 π”Š by (rule assms(3))
  show "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
    by (intro is_tiny_iso_ntcfI is_tiny_ntcfI') 
     (auto intro: cat_cs_intros cat_small_cs_intros)
qed

lemma is_tiny_iso_ntcfD':
  assumes "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
proof-
  interpret 𝔑: is_tiny_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  show "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
    by (auto intro: cat_cs_intros cat_small_cs_intros)
qed

lemma is_tiny_iso_ntcfE':
  assumes "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  obtains "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  using assms by (auto dest: is_tiny_ntcfD'(2,3))

lemma is_tiny_iso_ntcf_iff:
  "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅 ⟷ 
    (
      𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅 ∧ 
      𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅 ∧ 
      π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅
    )"
  by (auto intro: is_tiny_iso_ntcfI' dest: is_tiny_ntcfD'(2,3))


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma iso_tiny_ntcf_is_arr_isomorphism:
  assumes "category Ξ± 𝔅" and "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
  shows [ntcf_cs_intros]: "inv_ntcf 𝔑 : π”Š ↦CF.tiny.iso 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "𝔑 βˆ™NTCF inv_ntcf 𝔑 = ntcf_id π”Š"
    and "inv_ntcf 𝔑 βˆ™NTCF 𝔑 = ntcf_id 𝔉"
proof-
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(1))
  interpret 𝔑: is_tiny_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms)
  note inv_𝔑 = iso_ntcf_is_arr_isomorphism[OF 𝔑.is_iso_ntcf_axioms]
  show "inv_ntcf 𝔑 : π”Š ↦CF.tiny.iso 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
  proof(intro is_tiny_iso_ntcfI)
    show "inv_ntcf 𝔑 : π”Š ↦CF.iso 𝔉 : 𝔄 ↦↦CΞ± 𝔅" by (intro inv_𝔑(1))
    interpret inv_𝔑: is_iso_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 β€Ήinv_ntcf 𝔑› by (rule inv_𝔑(1))
    show "inv_ntcf 𝔑 : π”Š ↦CF.tiny 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
      by (intro is_tiny_ntcfI') (auto intro: cat_small_cs_intros cat_cs_intros)
  qed
  show "𝔑 βˆ™NTCF inv_ntcf 𝔑 = ntcf_id π”Š" "inv_ntcf 𝔑 βˆ™NTCF 𝔑 = ntcf_id 𝔉" 
    by (intro inv_𝔑(2,3))+
qed

lemma is_arr_isomorphism_is_tiny_iso_ntcf:
  assumes "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and "𝔐 : π”Š ↦CF.tiny 𝔉 : 𝔄 ↦↦C.tinyΞ± 𝔅"
    and [simp]: "𝔑 βˆ™NTCF 𝔐 = ntcf_id π”Š"
    and [simp]: "𝔐 βˆ™NTCF 𝔑 = ntcf_id 𝔉"
  shows "𝔑 : 𝔉 ↦CF.tiny.iso π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
proof-
  interpret 𝔑: is_tiny_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret 𝔐: is_tiny_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 𝔐 by (rule assms(2))
  show ?thesis
  proof(rule is_tiny_iso_ntcfI)
    show "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
      by (rule is_arr_isomorphism_is_iso_ntcf) (auto intro: cat_small_cs_intros)
    show "𝔑 : 𝔉 ↦CF.tiny π”Š : 𝔄 ↦↦C.tinyΞ± 𝔅"
      by (rule is_tiny_ntcfI') (auto intro: cat_small_cs_intros)
  qed
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_PCategory

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉProduct categoryβ€Ί
theory CZH_ECAT_PCategory
  imports 
    CZH_ECAT_NTCF
    CZH_ECAT_Small_Category
    CZH_Foundations.CZH_SMC_PSemicategory
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€ΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.β€Ί

named_theorems cat_prod_cs_simps
named_theorems cat_prod_cs_intros



subsectionβ€ΉProduct category: definition and elementary propertiesβ€Ί 

definition cat_prod :: "V β‡’ (V β‡’ V) β‡’ V" 
  where "cat_prod I 𝔄 =
    [
      (∏∘i∈∘I. 𝔄 i⦇Obj⦈),
      (∏∘i∈∘I. 𝔄 i⦇Arr⦈),
      (Ξ»f∈∘(∏∘i∈∘I. 𝔄 i⦇Arr⦈). (Ξ»i∈∘I. 𝔄 i⦇Domβ¦ˆβ¦‡f⦇i⦈⦈)),
      (Ξ»f∈∘(∏∘i∈∘I. 𝔄 i⦇Arr⦈). (Ξ»i∈∘I. 𝔄 i⦇Codβ¦ˆβ¦‡f⦇i⦈⦈)),
      (
        Ξ»gf∈∘composable_arrs (dg_prod I 𝔄).
          (Ξ»i∈∘I. vpfst gf⦇i⦈ ∘A𝔄 i vpsnd gf⦇i⦈)
      ),
      (Ξ»a∈∘(∏∘i∈∘I. 𝔄 i⦇Obj⦈). (Ξ»i∈∘I. 𝔄 i⦇CIdβ¦ˆβ¦‡a⦇i⦈⦈))
    ]∘"

syntax "_PCATEGORY" :: "pttrn β‡’ V β‡’ (V β‡’ V) β‡’ V" 
  ("(3∏C_∈∘_./ _)" [0, 0, 10] 10)
translations "∏Ci∈∘I. 𝔄" β‡Œ "CONST cat_prod I (Ξ»i. 𝔄)"


textβ€ΉComponents.β€Ί

lemma cat_prod_components:
  shows "(∏Ci∈∘I. 𝔄 i)⦇Obj⦈ = (∏∘i∈∘I. 𝔄 i⦇Obj⦈)"
    and "(∏Ci∈∘I. 𝔄 i)⦇Arr⦈ = (∏∘i∈∘I. 𝔄 i⦇Arr⦈)"
    and "(∏Ci∈∘I. 𝔄 i)⦇Dom⦈ =
      (Ξ»f∈∘(∏∘i∈∘I. 𝔄 i⦇Arr⦈). (Ξ»i∈∘I. 𝔄 i⦇Domβ¦ˆβ¦‡f⦇i⦈⦈))"
    and "(∏Ci∈∘I. 𝔄 i)⦇Cod⦈ =
      (Ξ»f∈∘(∏∘i∈∘I. 𝔄 i⦇Arr⦈). (Ξ»i∈∘I. 𝔄 i⦇Codβ¦ˆβ¦‡f⦇i⦈⦈))"
    and "(∏Ci∈∘I. 𝔄 i)⦇Comp⦈ =
      (
        Ξ»gf∈∘composable_arrs (dg_prod I 𝔄).
          (Ξ»i∈∘I. vpfst gf⦇i⦈ ∘A𝔄 i vpsnd gf⦇i⦈)
      )"
    and "(∏Ci∈∘I. 𝔄 i)⦇CId⦈ =
      (Ξ»a∈∘(∏∘i∈∘I. 𝔄 i⦇Obj⦈). (Ξ»i∈∘I. 𝔄 i⦇CIdβ¦ˆβ¦‡a⦇i⦈⦈))"
  unfolding cat_prod_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_cat_prod[slicing_commute]: 
  "smc_prod I (Ξ»i. cat_smc (𝔄 i)) = cat_smc (∏Ci∈∘I. 𝔄 i)"
  unfolding dg_prod_def cat_smc_def cat_prod_def smc_prod_def dg_field_simps
  by (simp_all add: nat_omega_simps)

context
  fixes 𝔄 Ο† :: "V β‡’ V"
    and β„­ :: V
begin

lemmas_with [
  where 𝔄=β€ΉΞ»i. cat_smc (𝔄 i)β€Ί, unfolded slicing_simps slicing_commute
  ]:
  cat_prod_ObjI = smc_prod_ObjI
  and cat_prod_ObjD = smc_prod_ObjD
  and cat_prod_ObjE = smc_prod_ObjE
  and cat_prod_Obj_cong = smc_prod_Obj_cong
  and cat_prod_ArrI = smc_prod_ArrI
  and cat_prod_ArrD = smc_prod_ArrD
  and cat_prod_ArrE = smc_prod_ArrE
  and cat_prod_Arr_cong = smc_prod_Arr_cong
  and cat_prod_Dom_vsv[cat_cs_intros] = smc_prod_Dom_vsv
  and cat_prod_Dom_vdomain[cat_cs_simps] = smc_prod_Dom_vdomain
  and cat_prod_Dom_app = smc_prod_Dom_app
  and cat_prod_Dom_app_component_app[cat_cs_simps] = 
    smc_prod_Dom_app_component_app
  and cat_prod_Cod_vsv[cat_cs_intros] = smc_prod_Cod_vsv
  and cat_prod_Cod_app = smc_prod_Cod_app
  and cat_prod_Cod_vdomain[cat_cs_simps] = smc_prod_Cod_vdomain
  and cat_prod_Cod_app_component_app[cat_cs_simps] = 
    smc_prod_Cod_app_component_app
  and cat_prod_Comp = smc_prod_Comp
  and cat_prod_Comp_vdomain[cat_cs_simps] = smc_prod_Comp_vdomain
  and cat_prod_Comp_app = smc_prod_Comp_app
  and cat_prod_Comp_app_component[cat_cs_simps] = 
    smc_prod_Comp_app_component
  and cat_prod_Comp_app_vdomain = smc_prod_Comp_app_vdomain
  and cat_prod_vunion_Obj_in_Obj = smc_prod_vunion_Obj_in_Obj
  and cat_prod_vdiff_vunion_Obj_in_Obj = smc_prod_vdiff_vunion_Obj_in_Obj
  and cat_prod_vunion_Arr_in_Arr = smc_prod_vunion_Arr_in_Arr
  and cat_prod_vdiff_vunion_Arr_in_Arr = smc_prod_vdiff_vunion_Arr_in_Arr

end



subsectionβ€ΉLocal assumptions for a product categoryβ€Ί

locale pcategory_base = 𝒡 Ξ± for Ξ± I 𝔄 +
  assumes pcat_categories: "i ∈∘ I ⟹ category Ξ± (𝔄 i)"
    and pcat_index_in_Vset[cat_cs_intros]: "I ∈∘ Vset α"

lemma (in pcategory_base) pcat_categories'[cat_prod_cs_intros]:
  assumes "i ∈∘ I" and "α' = α"
  shows "category Ξ±' (𝔄 i)" 
  using assms(1) unfolding assms(2) by (rule pcat_categories)


textβ€ΉRules.β€Ί

lemma (in pcategory_base) pcategory_base_axioms'[cat_prod_cs_intros]: 
  assumes "Ξ±' = Ξ±" and "I' = I"
  shows "pcategory_base Ξ±' I' 𝔄"
  unfolding assms by (rule pcategory_base_axioms)

mk_ide rf pcategory_base_def[unfolded pcategory_base_axioms_def]
  |intro pcategory_baseI|
  |dest pcategory_baseD[dest]|
  |elim pcategory_baseE[elim]|

lemma pcategory_base_psemicategory_baseI:
  assumes "psemicategory_base Ξ± I (Ξ»i. cat_smc (𝔄 i))" 
    and "β‹€i. i ∈∘ I ⟹ category Ξ± (𝔄 i)"
  shows "pcategory_base Ξ± I 𝔄"
proof-
  interpret psemicategory_base Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί by (rule assms(1))
  show ?thesis
    by (intro pcategory_baseI)
      (auto simp: assms(2) psmc_index_in_Vset psmc_Obj_in_Vset psmc_Arr_in_Vset) 
qed


textβ€ΉProduct category is a product semicategory.β€Ί

context pcategory_base
begin

lemma pcat_psemicategory_base: "psemicategory_base Ξ± I (Ξ»i. cat_smc (𝔄 i))"
proof(intro psemicategory_baseI)
  from pcat_index_in_Vset show "I ∈∘ Vset α" by auto
qed (auto simp: category.cat_semicategory cat_prod_cs_intros)

interpretation psmc: psemicategory_base Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
  by (rule pcat_psemicategory_base)

lemmas_with [unfolded slicing_simps slicing_commute]: 
  pcat_Obj_in_Vset = psmc.psmc_Obj_in_Vset
  and pcat_Arr_in_Vset = psmc.psmc_Arr_in_Vset
  and pcat_smc_prod_Obj_in_Vset = psmc.psmc_smc_prod_Obj_in_Vset
  and pcat_smc_prod_Arr_in_Vset = psmc.psmc_smc_prod_Arr_in_Vset
  and cat_prod_Dom_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Dom_app_in_Obj
  and cat_prod_Cod_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Cod_app_in_Obj
  and cat_prod_is_arrI = psmc.smc_prod_is_arrI
  and cat_prod_is_arrD[dest] = psmc.smc_prod_is_arrD
  and cat_prod_is_arrE[elim] = psmc.smc_prod_is_arrE

end

lemma cat_prod_dg_prod_is_arr: 
  "g : b ↦dg_prod I 𝔄 c ⟷ g : b ↦(∏Ci∈∘I. 𝔄 i) c"
  unfolding is_arr_def cat_prod_def smc_prod_def dg_prod_def dg_field_simps
  by (simp add: nat_omega_simps)

lemma smc_prod_composable_arrs_dg_prod:
  "composable_arrs (dg_prod I 𝔄) = composable_arrs (∏Ci∈∘I. 𝔄 i)"
  unfolding composable_arrs_def cat_prod_dg_prod_is_arr by simp


textβ€ΉElementary properties.β€Ί

lemma (in pcategory_base) pcat_vsubset_index_pcategory_base:
  assumes "J βŠ†βˆ˜ I"
  shows "pcategory_base Ξ± J 𝔄"
proof(intro pcategory_baseI)
  show "category Ξ± (𝔄 i)" if "i ∈∘ J" for i 
    using that assms by (auto intro: cat_prod_cs_intros)
  from assms show "J ∈∘ Vset α" by (simp add: vsubset_in_VsetI cat_cs_intros)
qed auto


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_prod_CId_vsv[cat_cs_intros]: "vsv ((∏Ci∈∘I. 𝔄 i)⦇CId⦈)"
  unfolding cat_prod_components by auto

lemma cat_prod_CId_vdomain[cat_cs_simps]: 
  "π’Ÿβˆ˜ ((∏Ci∈∘I. 𝔄 i)⦇CId⦈) = (∏Ci∈∘I. 𝔄 i)⦇Obj⦈" 
  unfolding cat_prod_components by simp

lemma cat_prod_CId_app: 
  assumes "a ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Obj⦈"
  shows "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡a⦈ = (Ξ»i∈∘I. 𝔄 i⦇CIdβ¦ˆβ¦‡a⦇i⦈⦈)" 
  using assms unfolding cat_prod_components by simp

lemma cat_prod_CId_app_component[cat_cs_simps]: 
  assumes "a ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Obj⦈" and "i ∈∘ I"
  shows "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡aβ¦ˆβ¦‡i⦈ = 𝔄 i⦇CIdβ¦ˆβ¦‡a⦇i⦈⦈" 
  using assms unfolding cat_prod_components by simp

lemma (in pcategory_base) cat_prod_CId_vrange: 
  "β„›βˆ˜ ((∏Ci∈∘I. 𝔄 i)⦇CId⦈) βŠ†βˆ˜ (∏∘i∈∘I. 𝔄 i⦇Arr⦈)" 
proof(intro vsubsetI)
  interpret CId: vsv β€Ή((∏Ci∈∘I. 𝔄 i)⦇CId⦈)β€Ί by (rule cat_prod_CId_vsv)
  fix f assume "f ∈∘ β„›βˆ˜ ((∏Ci∈∘I. 𝔄 i)⦇CId⦈)"
  then obtain a where f_def: "f = ((∏Ci∈∘I. 𝔄 i)⦇CId⦈)⦇a⦈" 
    and "a ∈∘ π’Ÿβˆ˜ ((∏Ci∈∘I. 𝔄 i)⦇CId⦈)"
    by (blast dest: CId.vrange_atD)
  then have a: "a ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Obj⦈" 
    unfolding cat_prod_components by simp
  show "f ∈∘ (∏∘i∈∘I. 𝔄 i⦇Arr⦈)"
    unfolding f_def cat_prod_CId_app[OF a]
  proof(rule VLambda_in_vproduct)
    fix i assume prems: "i ∈∘ I"
    interpret 𝔄: category Ξ± ‹𝔄 iβ€Ί 
      by (simp add: β€Ήi ∈∘ Iβ€Ί cat_cs_intros cat_prod_cs_intros)
    from prems a have "a⦇i⦈ ∈∘ 𝔄 i⦇Obj⦈" unfolding cat_prod_components by auto
    with is_arrD(1) show "𝔄 i⦇CIdβ¦ˆβ¦‡a⦇i⦈⦈ ∈∘ 𝔄 i⦇Arr⦈" 
      by (auto intro: cat_cs_intros)
  qed
qed


subsubsectionβ€ΉA product β€ΉΞ±β€Ί-category is a tiny β€ΉΞ²β€Ί-categoryβ€Ί

lemma (in pcategory_base) pcat_tiny_category_cat_prod:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" 
  shows "tiny_category Ξ² (∏Ci∈∘I. 𝔄 i)"
proof-

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))

  show ?thesis
  proof(intro tiny_categoryI, (unfold slicing_simps)?)
  
    show Ξ : "tiny_semicategory Ξ² (cat_smc (∏Ci∈∘I. 𝔄 i))"
      unfolding slicing_commute[symmetric]
      by 
        (
          intro psemicategory_base.psmc_tiny_semicategory_smc_prod; 
          (rule assms pcat_psemicategory_base)?
        )
    interpret Ξ : tiny_semicategory Ξ² β€Ήcat_smc (∏Ci∈∘I. 𝔄 i)β€Ί by (rule Ξ )
  
    show "vfsequence (∏Ci∈∘I. 𝔄 i)" unfolding cat_prod_def by auto
    show "vcard (∏Ci∈∘I. 𝔄 i) = 6β„•"
      unfolding cat_prod_def by (simp add: nat_omega_simps)
  
    show CId: "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡a⦈ : a ↦(∏Ci∈∘I. 𝔄 i) a"
      if a: "a ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Obj⦈" for a
    proof(rule cat_prod_is_arrI)
      have [cat_cs_intros]: "a⦇i⦈ ∈∘ 𝔄 i⦇Obj⦈" if i: "i ∈∘ I" for i
        by (rule cat_prod_ObjD(3)[OF a i])
      from that show "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡aβ¦ˆβ¦‡i⦈ : a⦇i⦈ ↦𝔄 i a⦇i⦈"
        if "i ∈∘ I" for i
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros that
          )
    qed (use that in β€Ήauto simp: cat_prod_components cat_prod_CId_app thatβ€Ί)
  
    show "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈ ∘A(∏Ci∈∘I. 𝔄 i) f = f"
      if "f : a ↦(∏Ci∈∘I. 𝔄 i) b" for f a b
    proof(rule cat_prod_Arr_cong)
      note f = Ξ .smc_is_arrD[unfolded slicing_simps, OF that]
      note a = f(2) and b = f(3) and f = f(1)
      from CId[OF b] have CId_b: 
        "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈ : b ↦(∏Ci∈∘I. 𝔄 i) b"
        by simp
      from Ξ .smc_Comp_is_arr[unfolded slicing_simps, OF this that] show 
        "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈ ∘A(∏Ci∈∘I. 𝔄 i) f ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈"
        by (simp add: cat_cs_intros)
      from that show "f ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈" by auto
      fix i assume prems: "i ∈∘ I"
      interpret 𝔄i: category Ξ± ‹𝔄 iβ€Ί by (simp add: prems cat_prod_cs_intros)
      from prems cat_prod_is_arrD(7)[OF that] have fi: 
        "f⦇i⦈ : a⦇i⦈ ↦𝔄 i b⦇i⦈" 
        by auto
      from prems show "((∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈ ∘A(∏Ci∈∘I. 𝔄 i) f)⦇i⦈ = f⦇i⦈"
        unfolding cat_prod_Comp_app_component[OF CId_b that prems]
        unfolding cat_prod_CId_app[OF b]
        by (auto intro: 𝔄i.cat_CId_left_left[OF fi])
    qed

    show "f ∘A(∏Ci∈∘I. 𝔄 i) (∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈ = f"
      if "f : b ↦(∏Ci∈∘I. 𝔄 i) c" for f b c
    proof(rule cat_prod_Arr_cong)
      note f = Ξ .smc_is_arrD[unfolded slicing_simps, OF that]
      note b = f(2) and c = f(3) and f = f(1)
      from CId[OF b] have CId_b: 
        "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈ : b ↦(∏Ci∈∘I. 𝔄 i) b"
        by simp
      from Ξ .smc_Comp_is_arr[unfolded slicing_simps, OF that this] show 
        "f ∘A(∏Ci∈∘I. 𝔄 i) (∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈ ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈"
        by (simp add: cat_cs_intros)
      from that show "f ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈" by auto
      fix i assume prems: "i ∈∘ I"
      interpret 𝔄i: category Ξ± ‹𝔄 iβ€Ί by (simp add: prems cat_prod_cs_intros)
      from prems cat_prod_is_arrD[OF that] have fi: "f⦇i⦈ : b⦇i⦈ ↦𝔄 i c⦇i⦈"
        by simp
      from prems show "(f ∘A(∏Ci∈∘I. 𝔄 i) (∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡b⦈)⦇i⦈ = f⦇i⦈"
        unfolding cat_prod_Comp_app_component[OF that CId_b prems]
        unfolding cat_prod_CId_app[OF b]
        by (auto intro: 𝔄i.cat_CId_right_left[OF fi])
    qed
  
  qed (auto simp: cat_cs_intros cat_cs_simps intro: cat_cs_intros)

qed



subsectionβ€ΉFurther local assumptions for product categoriesβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale pcategory = pcategory_base Ξ± I 𝔄 for Ξ± I 𝔄 +
  assumes pcat_Obj_vsubset_Vset: "J βŠ†βˆ˜ I ⟹ (∏Ci∈∘J. 𝔄 i)⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    and pcat_Hom_vifunion_in_Vset: 
      "⟦
        J βŠ†βˆ˜ I;
        A βŠ†βˆ˜ (∏Ci∈∘J. 𝔄 i)⦇Obj⦈;
        B βŠ†βˆ˜ (∏Ci∈∘J. 𝔄 i)⦇Obj⦈;
        A ∈∘ Vset α;
        B ∈∘ Vset α
      ⟧ ⟹ (β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (∏Ci∈∘J. 𝔄 i) a b) ∈∘ Vset Ξ±"


textβ€ΉRules.β€Ί

lemma (in pcategory) pcategory_axioms'[cat_prod_cs_intros]: 
  assumes "Ξ±' = Ξ±" and "I' = I"
  shows "pcategory Ξ±' I' 𝔄"
  unfolding assms by (rule pcategory_axioms)

mk_ide rf pcategory_def[unfolded pcategory_axioms_def]
  |intro pcategoryI|
  |dest pcategoryD[dest]|
  |elim pcategoryE[elim]|

lemmas [cat_prod_cs_intros] = pcategoryD(1)

lemma pcategory_psemicategoryI:
  assumes "psemicategory Ξ± I (Ξ»i. cat_smc (𝔄 i))" 
    and "β‹€i. i ∈∘ I ⟹ category Ξ± (𝔄 i)"
  shows "pcategory Ξ± I 𝔄"
proof-
  interpret psemicategory Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί by (rule assms(1))
  note [unfolded slicing_simps slicing_commute, cat_cs_intros] = 
    psmc_Obj_vsubset_Vset
    psmc_Hom_vifunion_in_Vset
  show ?thesis
    by (intro pcategoryI pcategory_base_psemicategory_baseI)
      (auto simp: assms(2) smc_prod_cs_intros intro!: cat_cs_intros)
qed


textβ€ΉProduct category is a product semicategory.β€Ί

context pcategory
begin

lemma pcat_psemicategory: "psemicategory Ξ± I (Ξ»i. cat_smc (𝔄 i))"
proof(intro psemicategoryI, unfold slicing_simps slicing_commute)
  show "psemicategory_base Ξ± I (Ξ»i. cat_smc (𝔄 i))" 
    by (rule pcat_psemicategory_base)
qed (auto intro!: pcat_Obj_vsubset_Vset pcat_Hom_vifunion_in_Vset)

interpretation psmc: psemicategory Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
  by (rule pcat_psemicategory)

lemmas_with [unfolded slicing_simps slicing_commute]: 
  pcat_Obj_vsubset_Vset' = psmc.psmc_Obj_vsubset_Vset'
  and pcat_Hom_vifunion_in_Vset' = psmc.psmc_Hom_vifunion_in_Vset'
  and pcat_cat_prod_vunion_is_arr = psmc.psmc_smc_prod_vunion_is_arr
  and pcat_cat_prod_vdiff_vunion_is_arr = psmc.psmc_smc_prod_vdiff_vunion_is_arr

lemmas_with [unfolded slicing_simps slicing_commute]: 
  pcat_cat_prod_vunion_Comp = psmc.psmc_smc_prod_vunion_Comp
  and pcat_cat_prod_vdiff_vunion_Comp = psmc.psmc_smc_prod_vdiff_vunion_Comp

end


textβ€ΉElementary properties.β€Ί

lemma (in pcategory) pcat_vsubset_index_pcategory:
  assumes "J βŠ†βˆ˜ I"
  shows "pcategory Ξ± J 𝔄"
proof(intro pcategoryI pcategory_psemicategoryI)
  show "cat_prod J' 𝔄⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±" if β€ΉJ' βŠ†βˆ˜ Jβ€Ί for J'
  proof-
    from that assms have "J' βŠ†βˆ˜ I" by simp
    then show "cat_prod J' 𝔄⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±" by (rule pcat_Obj_vsubset_Vset)
  qed
  fix A B J' assume prems:
    "J' βŠ†βˆ˜ J"
    "A βŠ†βˆ˜ (∏Ci∈∘J'. 𝔄 i)⦇Obj⦈"
    "B βŠ†βˆ˜ (∏Ci∈∘J'. 𝔄 i)⦇Obj⦈"
    "A ∈∘ Vset α" 
    "B ∈∘ Vset α"
  show "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (∏Ci∈∘J'. 𝔄 i) a b) ∈∘ Vset Ξ±"
  proof-
    from prems(1) assms have "J' βŠ†βˆ˜ I" by simp
    from pcat_Hom_vifunion_in_Vset[OF this prems(2-5)] show ?thesis.
  qed
  
qed (rule pcat_vsubset_index_pcategory_base[OF assms])


subsubsectionβ€ΉA product β€ΉΞ±β€Ί-category is an β€ΉΞ±β€Ί-categoryβ€Ί

lemma (in pcategory) pcat_category_cat_prod: "category Ξ± (∏Ci∈∘I. 𝔄 i)"
proof-
  interpret tiny_category β€ΉΞ± + Ο‰β€Ί β€ΉβˆCi∈∘I. 𝔄 iβ€Ί
    by (intro pcat_tiny_category_cat_prod) 
      (auto simp: 𝒡_Ξ±_Ξ±Ο‰ 𝒡.intro 𝒡_Limit_Ξ±Ο‰ 𝒡_Ο‰_Ξ±Ο‰)
  show ?thesis
    by (rule category_if_category)  
      (
        auto 
          intro!: pcat_Hom_vifunion_in_Vset pcat_Obj_vsubset_Vset
          intro: cat_cs_intros
      )
qed



subsectionβ€ΉLocal assumptions for a finite product categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale finite_pcategory = pcategory_base Ξ± I 𝔄 for Ξ± I 𝔄 +
  assumes fin_pcat_index_vfinite: "vfinite I"


textβ€ΉRules.β€Ί

lemma (in finite_pcategory) finite_pcategory_axioms[cat_prod_cs_intros]: 
  assumes "Ξ±' = Ξ±" and "I' = I"
  shows "finite_pcategory Ξ±' I' 𝔄"
  unfolding assms by (rule finite_pcategory_axioms)

mk_ide rf finite_pcategory_def[unfolded finite_pcategory_axioms_def]
  |intro finite_pcategoryI|
  |dest finite_pcategoryD[dest]|
  |elim finite_pcategoryE[elim]|

lemmas [cat_prod_cs_intros] = finite_pcategoryD(1)

lemma finite_pcategory_finite_psemicategoryI:
  assumes "finite_psemicategory Ξ± I (Ξ»i. cat_smc (𝔄 i))" 
    and "β‹€i. i ∈∘ I ⟹ category Ξ± (𝔄 i)"
  shows "finite_pcategory Ξ± I 𝔄"
proof-
  interpret finite_psemicategory Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί by (rule assms(1))
  show ?thesis
    by 
      (
        intro 
          assms
          finite_pcategoryI 
          pcategory_base_psemicategory_baseI 
          finite_psemicategoryD(1)[OF assms(1)]
          fin_psmc_index_vfinite
      )
qed


subsubsectionβ€Ή
Local assumptions for a finite product semicategory and local
assumptions for an arbitrary product semicategory
β€Ί

sublocale finite_pcategory βŠ† pcategory Ξ± I 𝔄
proof-
  interpret finite_psemicategory Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί
  proof(intro finite_psemicategoryI psemicategory_baseI)
    fix i assume "i ∈∘ I"
    then interpret 𝔄i: category Ξ± ‹𝔄 iβ€Ί by (simp add: pcat_categories)
    show "semicategory Ξ± (cat_smc (𝔄 i))" by (simp add: 𝔄i.cat_semicategory)
  qed (auto intro!: cat_cs_intros fin_pcat_index_vfinite)
  show "pcategory Ξ± I 𝔄"
    by (intro pcategory_psemicategoryI) 
      (simp_all add: pcat_categories psemicategory_axioms)
qed



subsectionβ€ΉBinary union and complementβ€Ί

lemma (in pcategory) pcat_cat_prod_vunion_CId:
  assumes "vdisjnt J K"
    and "J βŠ†βˆ˜ I"
    and "K βŠ†βˆ˜ I"
    and "a ∈∘ (∏Cj∈∘J. 𝔄 j)⦇Obj⦈"
    and "b ∈∘ (∏Cj∈∘K. 𝔄 j)⦇Obj⦈"
  shows 
    "(∏Cj∈∘J. 𝔄 j)⦇CIdβ¦ˆβ¦‡a⦈ βˆͺ∘ (∏Cj∈∘K. 𝔄 j)⦇CIdβ¦ˆβ¦‡b⦈ = 
      (∏Ci∈∘J βˆͺ∘ K. 𝔄 i)⦇CIdβ¦ˆβ¦‡a βˆͺ∘ b⦈"
proof-

  interpret J𝔄: pcategory Ξ± J 𝔄 
    using assms(2) by (simp add: pcat_vsubset_index_pcategory)
  interpret K𝔄: pcategory Ξ± K 𝔄 
    using assms(3) by (simp add: pcat_vsubset_index_pcategory)
  interpret JK𝔄: pcategory Ξ± β€ΉJ βˆͺ∘ Kβ€Ί 𝔄 
    using assms(2,3) by (simp add: pcat_vsubset_index_pcategory)

  interpret J𝔄': category Ξ± β€Ήcat_prod J 𝔄› 
    by (rule J𝔄.pcat_category_cat_prod)
  interpret K𝔄': category Ξ± β€Ήcat_prod K 𝔄› 
    by (rule K𝔄.pcat_category_cat_prod)
  interpret JK𝔄': category Ξ± β€Ήcat_prod (J βˆͺ∘ K) 𝔄› 
    by (rule JK𝔄.pcat_category_cat_prod)

  from assms(4) have CId_a: "cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡a⦈ : a ↦(∏Cj∈∘J. 𝔄 j) a" 
    by (auto intro: cat_cs_intros)
  from assms(5) have CId_b: "cat_prod K 𝔄⦇CIdβ¦ˆβ¦‡b⦈ : b ↦(∏Ck∈∘K. 𝔄 k) b" 
    by (auto intro: cat_cs_intros)
  have CId_a_CId_b: "cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡a⦈ βˆͺ∘ cat_prod K 𝔄⦇CIdβ¦ˆβ¦‡b⦈ :
    a βˆͺ∘ b ↦cat_prod (J βˆͺ∘ K) 𝔄 a βˆͺ∘ b"
    by (rule pcat_cat_prod_vunion_is_arr[OF assms(1-3) CId_a CId_b])
  from CId_a have a: "a ∈∘ cat_prod J 𝔄⦇Obj⦈" by (auto intro: cat_cs_intros)
  from CId_b have b: "b ∈∘ cat_prod K 𝔄⦇Obj⦈" by (auto intro: cat_cs_intros)
  from CId_a_CId_b have ab: "a βˆͺ∘ b ∈∘ cat_prod (J βˆͺ∘ K) 𝔄⦇Obj⦈" 
    by (auto intro: cat_cs_intros)

  note CId_aD = J𝔄.cat_prod_is_arrD[OF CId_a]
    and CId_bD = K𝔄.cat_prod_is_arrD[OF CId_b]

  show ?thesis
  proof(rule cat_prod_Arr_cong[of _ β€ΉJ βˆͺ∘ Kβ€Ί 𝔄])
    from CId_a_CId_b show 
      "cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡a⦈ βˆͺ∘ cat_prod K 𝔄⦇CIdβ¦ˆβ¦‡b⦈ ∈∘ cat_prod (J βˆͺ∘ K) 𝔄⦇Arr⦈"
      by auto
    from ab show "cat_prod (J βˆͺ∘ K) 𝔄⦇CIdβ¦ˆβ¦‡a βˆͺ∘ b⦈ ∈∘ cat_prod (J βˆͺ∘ K) 𝔄⦇Arr⦈"
      by (auto intro: JK𝔄'.cat_is_arrD(1) cat_cs_intros)
    fix i assume "i ∈∘ J βˆͺ∘ K"
    then consider (iJ) β€Ήi ∈∘ Jβ€Ί | (iK) β€Ήi ∈∘ Kβ€Ί by auto
    then show "(cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡a⦈ βˆͺ∘ cat_prod K 𝔄⦇CIdβ¦ˆβ¦‡b⦈)⦇i⦈ = 
      cat_prod (J βˆͺ∘ K) 𝔄⦇CIdβ¦ˆβ¦‡a βˆͺ∘ bβ¦ˆβ¦‡i⦈"
      by cases
        (
          auto simp: 
            assms(1) 
            CId_aD(1-4) 
            CId_bD(1-4)
            cat_prod_CId_app[OF ab]
            cat_prod_CId_app[OF a]
            cat_prod_CId_app[OF b]
         )
  qed

qed

lemma (in pcategory) pcat_cat_prod_vdiff_vunion_CId:
  assumes "J βŠ†βˆ˜ I"
    and "a ∈∘ (∏Cj∈∘I -∘ J. 𝔄 j)⦇Obj⦈"
    and "b ∈∘ (∏Cj∈∘J. 𝔄 j)⦇Obj⦈"
  shows 
    "(∏Cj∈∘I -∘ J. 𝔄 j)⦇CIdβ¦ˆβ¦‡a⦈ βˆͺ∘ (∏Cj∈∘J. 𝔄 j)⦇CIdβ¦ˆβ¦‡b⦈ = 
      (∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡a βˆͺ∘ b⦈"
  by 
    (
      vdiff_of_vunion' 
        rule: pcat_cat_prod_vunion_CId assms: assms(2-3) subset: assms(1)
    )



subsectionβ€ΉProjectionβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_proj :: "V β‡’ (V β‡’ V) β‡’ V β‡’ V" (β€ΉΟ€Cβ€Ί)
  where "Ο€C I 𝔄 i =
    [
      (Ξ»a∈∘(∏∘i∈∘I. 𝔄 i⦇Obj⦈). a⦇i⦈),
      (Ξ»f∈∘(∏∘i∈∘I. 𝔄 i⦇Arr⦈). f⦇i⦈),
      (∏Ci∈∘I. 𝔄 i),
      𝔄 i
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_proj_components:
  shows "Ο€C I 𝔄 i⦇ObjMap⦈ = (Ξ»a∈∘(∏∘i∈∘I. 𝔄 i⦇Obj⦈). a⦇i⦈)"
    and "Ο€C I 𝔄 i⦇ArrMap⦈ = (Ξ»f∈∘(∏∘i∈∘I. 𝔄 i⦇Arr⦈). f⦇i⦈)"
    and "Ο€C I 𝔄 i⦇HomDom⦈ = (∏Ci∈∘I. 𝔄 i)"
    and "Ο€C I 𝔄 i⦇HomCod⦈ = 𝔄 i"
  unfolding cf_proj_def dghm_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicingβ€Ί

lemma cf_smcf_cf_proj[slicing_commute]: 
  "Ο€SMC I (Ξ»i. cat_smc (𝔄 i)) i = cf_smcf (Ο€C I 𝔄 i)"
  unfolding 
    cat_smc_def 
    cf_smcf_def 
    smcf_proj_def 
    cf_proj_def 
    cat_prod_def 
    smc_prod_def
    dg_prod_def
    dg_field_simps 
    dghm_field_simps 
  by (simp add: nat_omega_simps)

context pcategory
begin

interpretation psmc: psemicategory Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
  by (rule pcat_psemicategory)

lemmas_with [unfolded slicing_simps slicing_commute]: 
  pcat_cf_proj_is_semifunctor = psmc.psmc_smcf_proj_is_semifunctor

end


subsubsectionβ€ΉProjection functor is a functorβ€Ί

lemma (in pcategory) pcat_cf_proj_is_functor: 
  assumes "i ∈∘ I"
  shows "Ο€C I 𝔄 i : (∏Ci∈∘I. 𝔄 i) ↦↦CΞ± 𝔄 i"
proof(intro is_functorI)
  interpret 𝔄: category Ξ± β€Ή(∏Ci∈∘I. 𝔄 i)β€Ί 
    by (simp add: pcat_category_cat_prod)
  show "vfsequence (Ο€C I 𝔄 i)" unfolding cf_proj_def by simp
  show "category Ξ± (∏Ci∈∘I. 𝔄 i)" by (simp add: 𝔄.category_axioms)
  show "vcard (Ο€C I 𝔄 i) = 4β„•"
    unfolding cf_proj_def by (simp add: nat_omega_simps)
  show "Ο€C I 𝔄 i⦇ArrMapβ¦ˆβ¦‡(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡c⦈⦈ = 𝔄 i⦇CIdβ¦ˆβ¦‡Ο€C I 𝔄 i⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
    if "c ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Obj⦈" for c
  proof-
    interpret 𝔄i: category Ξ± ‹𝔄 iβ€Ί 
      by (auto intro: assms cat_prod_cs_intros)
    from that have "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡c⦈ : c ↦(∏Ci∈∘I. 𝔄 i) c"
      by (simp add: 𝔄.cat_CId_is_arr)
    then have "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡c⦈ ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈" 
      by (auto intro: cat_cs_intros)
    with assms have 
      "Ο€C I 𝔄 i⦇ArrMapβ¦ˆβ¦‡(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡c⦈⦈ = (∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦‡i⦈"
      unfolding cf_proj_components cat_prod_components by simp
    also from assms have "… = 𝔄 i⦇CIdβ¦ˆβ¦‡c⦇i⦈⦈"
      unfolding cat_prod_CId_app[OF that] by simp
    also from that have "… = 𝔄 i⦇CIdβ¦ˆβ¦‡Ο€C I 𝔄 i⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      unfolding cf_proj_components cat_prod_components by simp
    finally show 
      "Ο€C I 𝔄 i⦇ArrMapβ¦ˆβ¦‡(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡c⦈⦈ = 𝔄 i⦇CIdβ¦ˆβ¦‡Ο€C I 𝔄 i⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      by simp
  qed
qed 
  (
    auto simp: 
      assms cf_proj_components pcat_cf_proj_is_semifunctor cat_prod_cs_intros
  ) 

lemma (in pcategory) pcat_cf_proj_is_functor':
  assumes "i ∈∘ I" and "β„­ = (∏Ci∈∘I. 𝔄 i)" and "𝔇 = 𝔄 i"
  shows "Ο€C I 𝔄 i : β„­ ↦↦CΞ± 𝔇"
  using assms(1) unfolding assms(2,3) by (rule pcat_cf_proj_is_functor)

lemmas [cat_cs_intros] = pcategory.pcat_cf_proj_is_functor'



subsectionβ€ΉCategory product universal property functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

textβ€Ή
The functor that is presented in this section is used in the proof of 
the universal property of the product category later in this work.
β€Ί

definition cf_up :: "V β‡’ (V β‡’ V) β‡’ V β‡’ (V β‡’ V) β‡’ V"
  where "cf_up I 𝔄 β„­ Ο† =
    [
      (Ξ»aβˆˆβˆ˜β„­β¦‡Obj⦈. (Ξ»i∈∘I. Ο† i⦇ObjMapβ¦ˆβ¦‡a⦈)),
      (Ξ»fβˆˆβˆ˜β„­β¦‡Arr⦈. (Ξ»i∈∘I. Ο† i⦇ArrMapβ¦ˆβ¦‡f⦈)),
      β„­,
      (∏Ci∈∘I. 𝔄 i)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_up_components: 
  shows "cf_up I 𝔄 β„­ φ⦇ObjMap⦈ = (Ξ»aβˆˆβˆ˜β„­β¦‡Obj⦈. (Ξ»i∈∘I. Ο† i⦇ObjMapβ¦ˆβ¦‡a⦈))"
    and "cf_up I 𝔄 β„­ φ⦇ArrMap⦈ = (Ξ»fβˆˆβˆ˜β„­β¦‡Arr⦈. (Ξ»i∈∘I. Ο† i⦇ArrMapβ¦ˆβ¦‡f⦈))"
    and "cf_up I 𝔄 β„­ φ⦇HomDom⦈ = β„­"
    and "cf_up I 𝔄 β„­ φ⦇HomCod⦈ = (∏Ci∈∘I. 𝔄 i)"
  unfolding cf_up_def dghm_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma smcf_dghm_cf_up[slicing_commute]: 
  "smcf_up I (Ξ»i. cat_smc (𝔄 i)) (cat_smc β„­) (Ξ»i. cf_smcf (Ο† i)) = 
    cf_smcf (cf_up I 𝔄 β„­ Ο†)"
  unfolding 
    cat_smc_def 
    cf_smcf_def 
    cf_up_def 
    smcf_up_def 
    cat_prod_def 
    smc_prod_def
    dg_prod_def
    dg_field_simps 
    dghm_field_simps 
  by (simp add: nat_omega_simps)

context
  fixes 𝔄 Ο† :: "V β‡’ V"
    and β„­ :: V
begin

lemmas_with 
  [
    where 𝔄=β€ΉΞ»i. cat_smc (𝔄 i)β€Ί and Ο†=β€ΉΞ»i. cf_smcf (Ο† i)β€Ί and β„­ = β€Ήcat_smc β„­β€Ί, 
    unfolded slicing_simps slicing_commute
  ]:
  cf_up_ObjMap_vdomain[simp] = smcf_up_ObjMap_vdomain
  and cf_up_ObjMap_app = smcf_up_ObjMap_app
  and cf_up_ObjMap_app_vdomain[simp] = smcf_up_ObjMap_app_vdomain
  and cf_up_ObjMap_app_component = smcf_up_ObjMap_app_component
  and cf_up_ArrMap_vdomain[simp] = smcf_up_ArrMap_vdomain
  and cf_up_ArrMap_app = smcf_up_ArrMap_app
  and cf_up_ArrMap_app_vdomain[simp] = smcf_up_ArrMap_app_vdomain
  and cf_up_ArrMap_app_component = smcf_up_ArrMap_app_component

lemma cf_up_ObjMap_vrange:
  assumes "β‹€i. i ∈∘ I ⟹ Ο† i : β„­ ↦↦CΞ± 𝔄 i"
  shows "β„›βˆ˜ (cf_up I 𝔄 β„­ φ⦇ObjMap⦈) βŠ†βˆ˜ (∏Ci∈∘I. 𝔄 i)⦇Obj⦈"
proof
  (
    rule smcf_up_ObjMap_vrange[
      where 𝔄=β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
        and Ο†=β€ΉΞ»i. cf_smcf (Ο† i)β€Ί 
        and β„­=β€Ήcat_smc β„­β€Ί, 
      unfolded slicing_simps slicing_commute
      ]
  )
  fix i assume "i ∈∘ I"
  then interpret is_functor Ξ± β„­ ‹𝔄 iβ€Ί β€ΉΟ† iβ€Ί by (rule assms)
  show "cf_smcf (Ο† i) : cat_smc β„­ ↦↦SMCΞ± cat_smc (𝔄 i)"
    by (rule cf_is_semifunctor)
qed

lemma cf_up_ObjMap_app_vrange:
  assumes "a ∈∘ ℭ⦇Obj⦈" and "β‹€i. i ∈∘ I ⟹ Ο† i : β„­ ↦↦CΞ± 𝔄 i"
  shows " β„›βˆ˜ (cf_up I 𝔄 β„­ φ⦇ObjMapβ¦ˆβ¦‡a⦈) βŠ†βˆ˜ (β‹ƒβˆ˜i∈∘I. 𝔄 i⦇Obj⦈)"
proof
  (
    rule smcf_up_ObjMap_app_vrange[
      where 𝔄=β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
        and Ο†=β€ΉΞ»i. cf_smcf (Ο† i)β€Ί 
        and β„­=β€Ήcat_smc β„­β€Ί, 
      unfolded slicing_simps slicing_commute
      ]
  )
  show "a ∈∘ ℭ⦇Obj⦈" by (rule assms)
  fix i assume "i ∈∘ I"
  then interpret is_functor Ξ± β„­ ‹𝔄 iβ€Ί β€ΉΟ† iβ€Ί by (rule assms(2))
  show "cf_smcf (Ο† i) : cat_smc β„­ ↦↦SMCΞ± cat_smc (𝔄 i)"
    by (rule cf_is_semifunctor)
qed

lemma cf_up_ArrMap_vrange:
  assumes "β‹€i. i ∈∘ I ⟹ Ο† i : β„­ ↦↦CΞ± 𝔄 i"
  shows "β„›βˆ˜ (cf_up I 𝔄 β„­ φ⦇ArrMap⦈) βŠ†βˆ˜ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈"
proof
  (
    rule smcf_up_ArrMap_vrange[
      where 𝔄=β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
        and Ο†=β€ΉΞ»i. cf_smcf (Ο† i)β€Ί 
        and β„­=β€Ήcat_smc β„­β€Ί, 
      unfolded slicing_simps slicing_commute
      ]
  )
  fix i assume "i ∈∘ I"
  then interpret is_functor Ξ± β„­ ‹𝔄 iβ€Ί β€ΉΟ† iβ€Ί by (rule assms)
  show "cf_smcf (Ο† i) : cat_smc β„­ ↦↦SMCΞ± cat_smc (𝔄 i)"
    by (rule cf_is_semifunctor)
qed

lemma cf_up_ArrMap_app_vrange:
  assumes "a ∈∘ ℭ⦇Arr⦈" and "β‹€i. i ∈∘ I ⟹ Ο† i : β„­ ↦↦CΞ± 𝔄 i"
  shows " β„›βˆ˜ (cf_up I 𝔄 β„­ φ⦇ArrMapβ¦ˆβ¦‡a⦈) βŠ†βˆ˜ (β‹ƒβˆ˜i∈∘I. 𝔄 i⦇Arr⦈)"
proof
  (
    rule smcf_up_ArrMap_app_vrange
      [
        where 𝔄=β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
          and Ο†=β€ΉΞ»i. cf_smcf (Ο† i)β€Ί 
          and β„­=β€Ήcat_smc β„­β€Ί, 
        unfolded slicing_simps slicing_commute
      ]
  )
  fix i assume "i ∈∘ I"
  then interpret is_functor Ξ± β„­ ‹𝔄 iβ€Ί β€ΉΟ† iβ€Ί by (rule assms(2))
  show "cf_smcf (Ο† i) : cat_smc β„­ ↦↦SMCΞ± cat_smc (𝔄 i)"
    by (rule cf_is_semifunctor)
qed (rule assms)

end

context pcategory
begin

interpretation psmc: psemicategory Ξ± I β€ΉΞ»i. cat_smc (𝔄 i)β€Ί 
  by (rule pcat_psemicategory)

lemmas_with [unfolded slicing_simps slicing_commute]: 
  pcat_smcf_comp_smcf_proj_smcf_up = psmc.psmc_Comp_smcf_proj_smcf_up
  and pcat_smcf_up_eq_smcf_proj = psmc.psmc_smcf_up_eq_smcf_proj

end


subsubsectionβ€ΉCategory product universal property functor is a functorβ€Ί

lemma (in pcategory) pcat_cf_up_is_functor:
  assumes "category Ξ± β„­" and "β‹€i. i ∈∘ I ⟹ Ο† i : β„­ ↦↦CΞ± 𝔄 i"
  shows "cf_up I 𝔄 β„­ Ο† : β„­ ↦↦CΞ± (∏Ci∈∘I. 𝔄 i)"
proof-
  interpret β„­: category Ξ± β„­ by (simp add: assms(1))
  interpret 𝔄: category Ξ± β€Ή(∏Ci∈∘I. 𝔄 i)β€Ί by (rule pcat_category_cat_prod)
  show ?thesis
  proof(intro is_functorI)
    show "vfsequence (cf_up I 𝔄 β„­ Ο†)" unfolding cf_up_def by simp
    show "vcard (cf_up I 𝔄 β„­ Ο†) = 4β„•"
      unfolding cf_up_def by (simp add: nat_omega_simps)
    show "cf_smcf (cf_up I 𝔄 β„­ Ο†) : cat_smc β„­ ↦↦SMCΞ± cat_smc (∏Ci∈∘I. 𝔄 i)"
      unfolding slicing_commute[symmetric]
      by (rule psemicategory.psmc_smcf_up_is_semifunctor)
        (
          auto simp: 
            assms(2)
            pcat_psemicategory 
            is_functor.cf_is_semifunctor 
            slicing_intros
        )
    show "cf_up I 𝔄 β„­ φ⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 
      (∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡cf_up I 𝔄 β„­ φ⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ ℭ⦇Obj⦈" for c
    proof(rule cat_prod_Arr_cong)
      from that is_arrD(1) have CId_c: "ℭ⦇CIdβ¦ˆβ¦‡c⦈ ∈∘ ℭ⦇Arr⦈" 
        by (auto intro: cat_cs_intros)
      from CId_c cf_up_ArrMap_vrange[OF assms(2), simplified]
      show "cf_up I 𝔄 β„­ φ⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈"
        unfolding cf_up_components by force
      have cf_up_Ο†_c: "cf_up I 𝔄 β„­ φ⦇ObjMapβ¦ˆβ¦‡c⦈ ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Obj⦈"
        unfolding cat_prod_components
      proof(intro vproductI ballI)
        fix i assume prems: "i ∈∘ I"
        interpret Ο†: is_functor Ξ± β„­ ‹𝔄 iβ€Ί β€ΉΟ† iβ€Ί by (simp add: prems assms(2))
        from that show  "cf_up I 𝔄 β„­ φ⦇ObjMapβ¦ˆβ¦‡cβ¦ˆβ¦‡i⦈ ∈∘ 𝔄 i⦇Obj⦈"
          unfolding cf_up_ObjMap_app_component[OF that prems] 
          by (auto intro: cat_cs_intros)
      qed (simp_all add: cf_up_ObjMap_app that cf_up_ObjMap_app[OF that])
      from 𝔄.cat_CId_is_arr[OF this] show 
        "(∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡cf_up I 𝔄 β„­ φ⦇ObjMapβ¦ˆβ¦‡c⦈⦈ ∈∘ (∏Ci∈∘I. 𝔄 i)⦇Arr⦈"
        by auto
      fix i assume prems: "i ∈∘ I"
      interpret Ο†: is_functor Ξ± β„­ ‹𝔄 iβ€Ί β€ΉΟ† iβ€Ί by (simp add: prems assms(2))
      from cf_up_Ο†_c prems show 
        "cf_up I 𝔄 β„­ φ⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβ¦‡i⦈ =
          (∏Ci∈∘I. 𝔄 i)⦇CIdβ¦ˆβ¦‡cf_up I 𝔄 β„­ φ⦇ObjMapβ¦ˆβ¦‡cβ¦ˆβ¦ˆβ¦‡i⦈"
        unfolding cf_up_ArrMap_app_component[OF CId_c prems] cat_prod_components
        by 
          (
            simp add: 
              that cf_up_ObjMap_app_component[OF that prems] Ο†.cf_ObjMap_CId 
          )
    qed 
  qed (auto simp: cf_up_components cat_cs_intros)
qed


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in pcategory) pcat_Comp_cf_proj_cf_up: 
  assumes "category Ξ± β„­" 
    and "β‹€i. i ∈∘ I ⟹ Ο† i : β„­ ↦↦CΞ± 𝔄 i" 
    and "i ∈∘ I" 
  shows "Ο† i = Ο€C I 𝔄 i ∘CF (cf_up I 𝔄 β„­ Ο†)"
proof-
  interpret Ο†: is_functor Ξ± β„­ ‹𝔄 iβ€Ί β€ΉΟ† iβ€Ί by (rule assms(2)[OF assms(3)])
  interpret Ο€: is_functor Ξ± β€Ή(∏Ci∈∘I. 𝔄 i)β€Ί ‹𝔄 iβ€Ί β€ΉΟ€C I 𝔄 iβ€Ί
    by (simp add: assms(3) pcat_cf_proj_is_functor)
  interpret up: is_functor Ξ± β„­ β€Ή(∏Ci∈∘I. 𝔄 i)β€Ί β€Ήcf_up I 𝔄 β„­ Ο†β€Ί
    by (simp add: assms(2) Ο†.HomDom.category_axioms pcat_cf_up_is_functor)
  show ?thesis
  proof(rule cf_smcf_eqI)
    show "Ο€C I 𝔄 i ∘CF cf_up I 𝔄 β„­ Ο† : β„­ ↦↦CΞ± 𝔄 i" 
      by (auto intro: cat_cs_intros)
    from assms show "cf_smcf (Ο† i) = cf_smcf (Ο€C I 𝔄 i ∘CF cf_up I 𝔄 β„­ Ο†)"
      unfolding slicing_simps slicing_commute[symmetric]
      by 
        (
          intro pcat_smcf_comp_smcf_proj_smcf_up[
            where Ο†=β€ΉΞ»i. cf_smcf (Ο† i)β€Ί, unfolded slicing_commute[symmetric]
            ]
        )
        (auto simp: is_functor.cf_is_semifunctor)
  qed (auto intro: cat_cs_intros)
qed

lemma (in pcategory) pcat_cf_up_eq_cf_proj:
  assumes "𝔉 : β„­ ↦↦CΞ± (∏Ci∈∘I. 𝔄 i)"
    and "β‹€i. i ∈∘ I ⟹ Ο† i = Ο€C I 𝔄 i ∘CF 𝔉"
  shows "cf_up I 𝔄 β„­ Ο† = 𝔉"
proof(rule cf_smcf_eqI)
  interpret 𝔉: is_functor Ξ± β„­ β€Ή(∏Ci∈∘I. 𝔄 i)β€Ί 𝔉 by (rule assms(1))
  show "cf_up I 𝔄 β„­ Ο† : β„­ ↦↦CΞ± (∏Ci∈∘I. 𝔄 i)"
  proof(rule pcat_cf_up_is_functor)
    fix i assume prems: "i ∈∘ I"
    then interpret Ο€: is_functor Ξ± β€Ή(∏Ci∈∘I. 𝔄 i)β€Ί ‹𝔄 iβ€Ί β€ΉΟ€C I 𝔄 iβ€Ί
      by (rule pcat_cf_proj_is_functor)
    show "Ο† i : β„­ ↦↦CΞ± 𝔄 i" 
      unfolding assms(2)[OF prems] by (auto intro: cat_cs_intros)
  qed (auto intro: cat_cs_intros)
  show "𝔉 : β„­ ↦↦CΞ± (∏Ci∈∘I. 𝔄 i)" by (rule assms(1))
  from assms show "cf_smcf (cf_up I 𝔄 β„­ Ο†) = cf_smcf 𝔉"
    unfolding slicing_commute[symmetric]
    by (intro pcat_smcf_up_eq_smcf_proj) (auto simp: slicing_commute)
qed simp_all



subsectionβ€ΉProdfunctor with respect to a fixed argumentβ€Ί

textβ€Ή
A prodfunctor is a functor whose domain is a product category. 
It is a generalization of the concept of the bifunctor,
as presented in Chapter II-3 in \cite{mac_lane_categories_2010}.  
β€Ί

definition prodfunctor_proj :: "V β‡’ V β‡’ (V β‡’ V) β‡’ V β‡’ V β‡’ V β‡’ V"
  where "prodfunctor_proj 𝔖 I 𝔄 𝔇 J c =
    [
      (Ξ»b∈∘(∏Ci∈∘I -∘ J. 𝔄 i)⦇Obj⦈. 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈),
      (Ξ»f∈∘(∏Ci∈∘I -∘ J. 𝔄 i)⦇Arr⦈. 𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ (∏Cj∈∘J. 𝔄 j)⦇CIdβ¦ˆβ¦‡c⦈⦈),
      (∏Ci∈∘I -∘ J. 𝔄 i),
      𝔇
    ]∘"

syntax "_PPRODFUNCTOR_PROJ" :: "V β‡’ pttrn β‡’ V β‡’ V β‡’ (V β‡’ V) β‡’ V β‡’ V β‡’ V" 
  (β€Ή(_β‡˜(3∏C_∈∘_-∘_./_),_⇙/'(/-,_/'))β€Ί [51, 51, 51, 51, 51, 51, 51] 51)
translations "π”–βˆCi∈∘I-∘J. 𝔄,𝔇(-,c)" β‡Œ 
  "CONST prodfunctor_proj 𝔖 I (Ξ»i. 𝔄) 𝔇 J c"


textβ€ΉComponents.β€Ί

lemma prodfunctor_proj_components:
  shows "(π”–βˆCi∈∘I -∘ J. 𝔄 i,𝔇(-,c))⦇ObjMap⦈ = 
      (Ξ»b∈∘(∏Ci∈∘I -∘ J. 𝔄 i)⦇Obj⦈. 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈)"
    and "(π”–βˆCi∈∘I -∘ J. 𝔄 i,𝔇(-,c))⦇ArrMap⦈ = 
      (Ξ»f∈∘(∏Ci∈∘I -∘ J. 𝔄 i)⦇Arr⦈. 𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ (∏Cj∈∘J. 𝔄 j)⦇CIdβ¦ˆβ¦‡c⦈⦈)"
    and "(π”–βˆCi∈∘I -∘ J. 𝔄 i,𝔇(-,c))⦇HomDom⦈ = (∏Ci∈∘I -∘ J. 𝔄 i)"
    and "(π”–βˆCi∈∘I -∘ J. 𝔄 i,𝔇(-,c))⦇HomCod⦈ = 𝔇"
  unfolding prodfunctor_proj_def dghm_field_simps
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda prodfunctor_proj_components(1)
  |vsv prodfunctor_proj_ObjMap_vsv[cat_cs_intros]|
  |vdomain prodfunctor_proj_ObjMap_vdomain[cat_cs_simps]|
  |app prodfunctor_proj_ObjMap_app[cat_cs_simps]|


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda prodfunctor_proj_components(2)
  |vsv prodfunctor_proj_ArrMap_vsv[cat_cs_intros]|
  |vdomain prodfunctor_proj_ArrMap_vdomain[cat_cs_simps]|
  |app  prodfunctor_proj_ArrMap_app[cat_cs_simps]|


subsubsectionβ€ΉProdfunctor with respect to a fixed argument is a functorβ€Ί

lemma (in pcategory) pcat_prodfunctor_proj_is_functor: 
  assumes "𝔖 : (∏Ci∈∘I. 𝔄 i) ↦↦CΞ± 𝔇" 
    and "c ∈∘ (∏Cj∈∘J. 𝔄 j)⦇Obj⦈"
    and "J βŠ†βˆ˜ I"
  shows "(π”–βˆCi∈∘I -∘ J. 𝔄 i,𝔇(-,c)) : (∏Ci∈∘I -∘ J. 𝔄 i) ↦↦CΞ± 𝔇"
proof-

  interpret is_functor Ξ± β€Ή(∏Ci∈∘I. 𝔄 i)β€Ί 𝔇 𝔖 by (rule assms(1))
  interpret 𝔄: pcategory Ξ± J 𝔄
    using assms(3) by (intro pcat_vsubset_index_pcategory) auto
  interpret J_𝔄: category Ξ± β€ΉβˆCi∈∘J. 𝔄 iβ€Ί by (rule 𝔄.pcat_category_cat_prod)
  interpret IJ: pcategory Ξ± β€ΉI -∘ Jβ€Ί 𝔄
    using assms(3) by (intro pcat_vsubset_index_pcategory) auto
  interpret IJ_𝔄: category Ξ± β€ΉβˆCi∈∘I -∘ J. 𝔄 iβ€Ί
    by (rule IJ.pcat_category_cat_prod)

  let ?IJ𝔄 = β€Ή(∏Ci∈∘I -∘ J. 𝔄 i)β€Ί

  from assms(2) have "c ∈∘ (∏∘j∈∘J. 𝔄 j⦇Obj⦈)"
    unfolding cat_prod_components by simp
  then have "(∏∘j∈∘J. 𝔄 j⦇Obj⦈) β‰  0" by (auto intro!: cat_cs_intros)

  show ?thesis
  proof(intro is_functorI', unfold prodfunctor_proj_components)

    show "vfsequence (prodfunctor_proj 𝔖 I 𝔄 𝔇 J c)"
      unfolding prodfunctor_proj_def by simp
    show "vcard (prodfunctor_proj 𝔖 I 𝔄 𝔇 J c) = 4β„•"
      unfolding prodfunctor_proj_def by (simp add: nat_omega_simps)

    show "β„›βˆ˜ (Ξ»b∈∘?IJ𝔄⦇Obj⦈. 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
    proof(intro vsubsetI)
      fix x assume "x ∈∘ β„›βˆ˜ (Ξ»b∈∘?IJ𝔄⦇Obj⦈. 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈)"
      then obtain b where x_def: "x = 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈" and b: "b ∈∘ ?IJ𝔄⦇Obj⦈"  
        by auto
      have "b βˆͺ∘ c ∈∘ cat_prod I 𝔄⦇Obj⦈"
      proof(rule cat_prod_vdiff_vunion_Obj_in_Obj)
        show "b ∈∘ ?IJ𝔄⦇Obj⦈" by (rule b)
      qed (intro assms(2,3))+
      then show "x ∈∘ 𝔇⦇Obj⦈" unfolding x_def by (auto intro: cat_cs_intros)
    qed

    show is_arr:
      "(Ξ»f∈∘?IJ𝔄⦇Arr⦈. 𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈)⦇f⦈ : 
        (Ξ»b∈∘?IJ𝔄⦇Obj⦈. 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈)⦇a⦈ ↦𝔇 
        (Ξ»b∈∘?IJ𝔄⦇Obj⦈. 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈)⦇b⦈"
      (is β€Ή?V_f: ?V_a ↦𝔇 ?V_bβ€Ί)
      if "f : a ↦?IJ𝔄 b" for f a b
    proof-
      let ?fc = β€Ήf βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡cβ¦ˆβ€Ί
      have "?fc : a βˆͺ∘ c ↦cat_prod I 𝔄 b βˆͺ∘ c"
      proof(rule pcat_cat_prod_vdiff_vunion_is_arr)
        show "f : a ↦?IJ𝔄 b" by (rule that)
      qed (auto simp: assms cat_cs_intros)
      then have "𝔖⦇ArrMapβ¦ˆβ¦‡?fc⦈ : 𝔖⦇ObjMapβ¦ˆβ¦‡a βˆͺ∘ c⦈ ↦𝔇 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈"
        by (auto intro: cat_cs_intros)
      moreover from that have "f ∈∘ ?IJ𝔄⦇Arr⦈" "a ∈∘ ?IJ𝔄⦇Obj⦈" "b ∈∘ ?IJ𝔄⦇Obj⦈"
        by (auto intro: cat_cs_intros) 
      ultimately show ?thesis by simp
    qed

    show 
      "(Ξ»f∈∘?IJ𝔄⦇Arr⦈. 𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈)⦇g ∘A?IJ𝔄 f⦈ =
      (Ξ»f∈∘?IJ𝔄⦇Arr⦈. 𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈)⦇g⦈ ∘A𝔇 
      (Ξ»f∈∘?IJ𝔄⦇Arr⦈. 𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈)⦇f⦈"
      if "g : b' ↦?IJ𝔄 c'" and "f : a' ↦?IJ𝔄 b'" for g b' c' f a'
    proof-
      from that have gf: "g ∘A?IJ𝔄 f : a' ↦?IJ𝔄 c'" 
        by (auto intro: cat_cs_intros)
      from assms(2) have CId_c: "cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈ : c ↦cat_prod J 𝔄 c" 
        by (auto intro: cat_cs_intros)
      then have [simp]:  
        "cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈ ∘Acat_prod J 𝔄 cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈ = 
          cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈"
        by (auto simp: cat_cs_simps)
      from assms(3) that(1) CId_c have g_CId_c:
        "g βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈ : b' βˆͺ∘ c ↦cat_prod I 𝔄 c' βˆͺ∘ c"
        by (rule pcat_cat_prod_vdiff_vunion_is_arr)
      from assms(3) that(2) CId_c have f_CId_c:
        "f βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈ : a' βˆͺ∘ c ↦cat_prod I 𝔄 b' βˆͺ∘ c"
        by (rule pcat_cat_prod_vdiff_vunion_is_arr)
      have 
        "𝔖⦇ArrMapβ¦ˆβ¦‡(g ∘A?IJ𝔄 f) βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈ = 
          𝔖⦇ArrMapβ¦ˆβ¦‡g βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈ ∘A𝔇
          𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈"
        unfolding 
          pcat_cat_prod_vdiff_vunion_Comp[
            OF assms(3) that(1) CId_c that(2) CId_c, simplified
            ]
        by (intro cf_ArrMap_Comp[OF g_CId_c f_CId_c])
      moreover from gf have "g ∘A?IJ𝔄 f ∈∘ ?IJ𝔄⦇Arr⦈" by auto
      moreover from that have "g ∈∘ ?IJ𝔄⦇Arr⦈" "f ∈∘ ?IJ𝔄⦇Arr⦈" by auto
      ultimately show ?thesis by simp
    qed

    show 
      "(Ξ»f∈∘?IJ𝔄⦇Arr⦈. 𝔖⦇ArrMapβ¦ˆβ¦‡f βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈)⦇?IJ𝔄⦇CIdβ¦ˆβ¦‡c'⦈⦈ = 
        𝔇⦇CIdβ¦ˆβ¦‡(Ξ»b∈∘?IJ𝔄⦇Obj⦈. 𝔖⦇ObjMapβ¦ˆβ¦‡b βˆͺ∘ c⦈)⦇c'⦈⦈"
      if "c' ∈∘ ?IJ𝔄⦇Obj⦈" for c'
    proof-
      have "?IJ𝔄⦇CIdβ¦ˆβ¦‡c'⦈ βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈ = cat_prod I 𝔄⦇CIdβ¦ˆβ¦‡c' βˆͺ∘ c⦈"
        unfolding pcat_cat_prod_vdiff_vunion_CId[OF assms(3) that assms(2)] ..
      moreover from assms(3) that assms(2) have "c' βˆͺ∘ c ∈∘ cat_prod I 𝔄⦇Obj⦈"
        by (rule cat_prod_vdiff_vunion_Obj_in_Obj)
      ultimately have "𝔖⦇ArrMapβ¦ˆβ¦‡?IJ𝔄⦇CIdβ¦ˆβ¦‡c'⦈ βˆͺ∘ cat_prod J 𝔄⦇CIdβ¦ˆβ¦‡c⦈⦈ =
        𝔇⦇CIdβ¦ˆβ¦‡π”–β¦‡ObjMapβ¦ˆβ¦‡c' βˆͺ∘ c⦈⦈"
        by (auto intro: cat_cs_intros) 
      moreover from that have CId_c': "?IJ𝔄⦇CIdβ¦ˆβ¦‡c'⦈ ∈∘ ?IJ𝔄⦇Arr⦈"
        by (auto dest!: IJ_𝔄.cat_CId_is_arr)
      ultimately show ?thesis by (simp add: that)
    qed

  qed (auto intro: cat_cs_intros) 

qed

lemma (in pcategory) pcat_prodfunctor_proj_is_functor': 
  assumes "𝔖 : (∏Ci∈∘I. 𝔄 i) ↦↦CΞ± 𝔇" 
    and "c ∈∘ (∏Cj∈∘J. 𝔄 j)⦇Obj⦈"
    and "J βŠ†βˆ˜ I"
    and "𝔄' = (∏Ci∈∘I -∘ J. 𝔄 i)"
    and "𝔅' = 𝔇"
  shows "(π”–βˆCi∈∘I -∘ J. 𝔄 i,𝔇(-,c)) : 𝔄' ↦↦CΞ± 𝔅'"
  using assms(1-3)
  unfolding assms(4,5)
  by (rule pcat_prodfunctor_proj_is_functor)

lemmas [cat_cs_intros] = pcategory.pcat_prodfunctor_proj_is_functor'



subsectionβ€ΉSingleton categoryβ€Ί


subsubsectionβ€ΉSlicingβ€Ί

context
  fixes β„­ :: V
begin

lemmas_with [where β„­=β€Ήcat_smc β„­β€Ί, unfolded slicing_simps slicing_commute]:
  cat_singleton_ObjI = smc_singleton_ObjI
  and cat_singleton_ObjE = smc_singleton_ObjE
  and cat_singleton_ArrI = smc_singleton_ArrI
  and cat_singleton_ArrE = smc_singleton_ArrE

end

context category
begin

interpretation smc: semicategory Ξ± β€Ήcat_smc β„­β€Ί by (rule cat_semicategory)

lemmas_with [unfolded slicing_simps slicing_commute]:
  cat_finite_psemicategory_cat_singleton = 
    smc.smc_finite_psemicategory_smc_singleton
  and cat_singleton_is_arrI = smc.smc_singleton_is_arrI
  and cat_singleton_is_arrD = smc.smc_singleton_is_arrD
  and cat_singleton_is_arrE = smc.smc_singleton_is_arrE

end


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_singleton_CId_app: 
  assumes "set {⟨j, a⟩} ∈∘ (∏Ci∈∘set {j}. β„­)⦇Obj⦈"
  shows "(∏Ci∈∘set {j}. β„­)⦇CIdβ¦ˆβ¦‡set {⟨j, a⟩}⦈ = set {⟨j, ℭ⦇CIdβ¦ˆβ¦‡a⦈⟩}"
  using assms unfolding cat_prod_components VLambda_vsingleton by simp


subsubsectionβ€ΉSingleton category is a categoryβ€Ί

lemma (in category) cat_finite_pcategory_cat_singleton: 
  assumes "j ∈∘ Vset α"
  shows "finite_pcategory Ξ± (set {j}) (Ξ»i. β„­)"
  by 
    (
      auto intro: 
        assms
        category_axioms 
        finite_pcategory_finite_psemicategoryI 
        cat_finite_psemicategory_cat_singleton 
    )

lemma (in category) cat_category_cat_singleton:
  assumes "j ∈∘ Vset α"
  shows "category Ξ± (∏Ci∈∘set {j}. β„­)"
proof-
  interpret finite_pcategory Ξ± β€Ήset {j}β€Ί β€ΉΞ»i. β„­β€Ί
    using assms by (rule cat_finite_pcategory_cat_singleton)
  show ?thesis by (rule pcat_category_cat_prod)
qed



subsectionβ€ΉSingleton functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_singleton :: "V β‡’ V β‡’ V"
  where "cf_singleton j β„­ =
    [
      (Ξ»aβˆˆβˆ˜β„­β¦‡Obj⦈. set {⟨j, a⟩}),
      (Ξ»fβˆˆβˆ˜β„­β¦‡Arr⦈. set {⟨j, f⟩}),
      β„­,
      (∏Ci∈∘set {j}. β„­)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_singleton_components:
  shows "cf_singleton j ℭ⦇ObjMap⦈ = (Ξ»aβˆˆβˆ˜β„­β¦‡Obj⦈. set {⟨j, a⟩})"
    and "cf_singleton j ℭ⦇ArrMap⦈ = (Ξ»fβˆˆβˆ˜β„­β¦‡Arr⦈. set {⟨j, f⟩})"
    and "cf_singleton j ℭ⦇HomDom⦈ = β„­"
    and "cf_singleton j ℭ⦇HomCod⦈ = (∏Ci∈∘set {j}. β„­)"
  unfolding cf_singleton_def dghm_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cf_smcf_cf_singleton[slicing_commute]: 
  "smcf_singleton j (cat_smc β„­)= cf_smcf (cf_singleton j β„­)"
  unfolding smcf_singleton_def cf_singleton_def slicing_simps slicing_commute
  by 
    (
      simp add: 
        nat_omega_simps dghm_field_simps dg_field_simps cat_smc_def cf_smcf_def
     )

context
  fixes β„­ :: V
begin

lemmas_with [where β„­=β€Ήcat_smc β„­β€Ί, unfolded slicing_simps slicing_commute]:
  cf_singleton_ObjMap_vsv[cat_cs_intros] = smcf_singleton_ObjMap_vsv
  and cf_singleton_ObjMap_vdomain[cat_cs_simps] = smcf_singleton_ObjMap_vdomain
  and cf_singleton_ObjMap_vrange = smcf_singleton_ObjMap_vrange
  and cf_singleton_ObjMap_app[cat_prod_cs_simps] = smcf_singleton_ObjMap_app
  and cf_singleton_ArrMap_vsv[cat_cs_intros] = smcf_singleton_ArrMap_vsv
  and cf_singleton_ArrMap_vdomain[cat_cs_simps] = smcf_singleton_ArrMap_vdomain
  and cf_singleton_ArrMap_vrange = smcf_singleton_ArrMap_vrange
  and cf_singleton_ArrMap_app[cat_prod_cs_simps] = smcf_singleton_ArrMap_app

end


subsubsectionβ€ΉSingleton functor is an isomorphism of categoriesβ€Ί

lemma (in category) cat_cf_singleton_is_functor:
  assumes "j ∈∘ Vset α"
  shows "cf_singleton j β„­ : β„­ ↦↦C.isoΞ± (∏Ci∈∘set {j}. β„­)"
proof(intro is_iso_functorI is_functorI)
  from assms show smcf_singleton: "cf_smcf (cf_singleton j β„­) : 
    cat_smc β„­ ↦↦SMC.isoΞ± cat_smc (∏Ci∈∘set {j}. β„­)"
    unfolding slicing_commute[symmetric]
    by (intro semicategory.smc_smcf_singleton_is_iso_semifunctor) 
      (auto intro: smc_cs_intros slicing_intros)
  show "vfsequence (cf_singleton j β„­)" unfolding cf_singleton_def by simp
  show "vcard (cf_singleton j β„­) = 4β„•"
    unfolding cf_singleton_def by (simp add: nat_omega_simps)
  show "cf_smcf (cf_singleton j β„­) : 
    cat_smc β„­ ↦↦SMCΞ± cat_smc (∏Ci∈∘set {j}. β„­)"
    by (intro is_iso_semifunctor.axioms(1) smcf_singleton)
  show "cf_singleton j ℭ⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 
    (∏Ci∈∘set {j}. β„­)⦇CIdβ¦ˆβ¦‡cf_singleton j ℭ⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
    if "c ∈∘ ℭ⦇Obj⦈" for c 
  proof-
    from that have CId_c: "ℭ⦇CIdβ¦ˆβ¦‡c⦈ : c ↦ℭ c" by (auto simp: cat_cs_intros)
    have "set {⟨j, c⟩} ∈∘ (∏Ci∈∘set {j}. β„­)⦇Obj⦈"
      by (simp add: cat_singleton_ObjI that)
    with that have "(∏Ci∈∘set {j}. β„­)⦇CIdβ¦ˆβ¦‡cf_singleton j ℭ⦇ObjMapβ¦ˆβ¦‡c⦈⦈ = 
      set {⟨j, ℭ⦇CIdβ¦ˆβ¦‡c⦈⟩}"
      by (simp add: cf_singleton_ObjMap_app cat_singleton_CId_app)
    moreover from CId_c have 
      "cf_singleton j ℭ⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = set {⟨j, ℭ⦇CIdβ¦ˆβ¦‡c⦈⟩}"
      by (auto simp: cf_singleton_ArrMap_app cat_cs_intros)
    ultimately show ?thesis by simp
  qed
qed 
  (
    auto simp: 
      cat_cs_intros assms cat_category_cat_singleton cf_singleton_components 
  )



subsectionβ€ΉProduct of two categoriesβ€Ί


subsubsectionβ€ΉDefinition and elementary properties.β€Ί


textβ€ΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.β€Ί

definition cat_prod_2 :: "V β‡’ V β‡’ V" (infixr β€ΉΓ—Cβ€Ί 80)
  where "𝔄 Γ—C 𝔅 ≑ cat_prod (2β„•) (Ξ»i. if i = 0 then 𝔄 else 𝔅)"


textβ€ΉSlicing.β€Ί
  
lemma cat_smc_cat_prod_2[slicing_commute]: 
  "cat_smc 𝔄 Γ—SMC cat_smc 𝔅 = cat_smc (𝔄 Γ—C 𝔅)"
  unfolding cat_prod_2_def smc_prod_2_def slicing_commute[symmetric] if_distrib
  by simp

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

lemmas_with 
  [
    where 𝔄=β€Ήcat_smc 𝔄› and 𝔅=β€Ήcat_smc 𝔅›, 
    unfolded slicing_simps slicing_commute, 
    OF 𝔄.cat_semicategory 𝔅.cat_semicategory
  ]:
  cat_prod_2_ObjI = smc_prod_2_ObjI 
  and cat_prod_2_ObjI'[cat_prod_cs_intros] = smc_prod_2_ObjI'
  and cat_prod_2_ObjE = smc_prod_2_ObjE
  and cat_prod_2_ArrI = smc_prod_2_ArrI
  and cat_prod_2_ArrI'[cat_prod_cs_intros] = smc_prod_2_ArrI'
  and cat_prod_2_ArrE = smc_prod_2_ArrE
  and cat_prod_2_is_arrI = smc_prod_2_is_arrI
  and cat_prod_2_is_arrI'[cat_prod_cs_intros] = smc_prod_2_is_arrI'
  and cat_prod_2_is_arrE = smc_prod_2_is_arrE
  and cat_prod_2_Dom_vsv = smc_prod_2_Dom_vsv
  and cat_prod_2_Dom_vdomain[cat_cs_simps] = smc_prod_2_Dom_vdomain
  and cat_prod_2_Dom_app[cat_prod_cs_simps] = smc_prod_2_Dom_app
  and cat_prod_2_Dom_vrange = smc_prod_2_Dom_vrange
  and cat_prod_2_Cod_vsv = smc_prod_2_Cod_vsv
  and cat_prod_2_Cod_vdomain[cat_cs_simps] = smc_prod_2_Cod_vdomain
  and cat_prod_2_Cod_app[cat_prod_cs_simps] = smc_prod_2_Cod_app
  and cat_prod_2_Cod_vrange = smc_prod_2_Cod_vrange
  and cat_prod_2_op_cat_cat_Obj[cat_op_simps] = smc_prod_2_op_smc_smc_Obj
  and cat_prod_2_cat_op_cat_Obj[cat_op_simps] = smc_prod_2_smc_op_smc_Obj
  and cat_prod_2_op_cat_cat_Arr[cat_op_simps] = smc_prod_2_op_smc_smc_Arr
  and cat_prod_2_cat_op_cat_Arr[cat_op_simps] = smc_prod_2_smc_op_smc_Arr

lemmas_with 
  [
    where 𝔄=β€Ήcat_smc 𝔄› and 𝔅=β€Ήcat_smc 𝔅›, 
    unfolded slicing_simps slicing_commute, 
    OF 𝔄.cat_semicategory 𝔅.cat_semicategory
  ]:
  cat_prod_2_Comp_app[cat_prod_cs_simps] = smc_prod_2_Comp_app

end


subsubsectionβ€ΉProduct of two categories is a categoryβ€Ί

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝒡 Ξ± by (rule categoryD[OF 𝔄])
interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

lemma finite_pcategory_cat_prod_2: "finite_pcategory Ξ± (2β„•) (if2 𝔄 𝔅)"
proof(intro finite_pcategoryI pcategory_baseI)
  from Axiom_of_Infinity show z1_in_Vset: "2β„• ∈∘ Vset Ξ±" by blast
  show "category Ξ± (i = 0 ? 𝔄 : 𝔅)" if "i ∈∘ 2β„•" for i
    by (auto simp: cat_cs_intros)
qed auto

interpretation finite_pcategory Ξ± β€Ή2β„•β€Ί β€Ήif2 𝔄 𝔅›
  by (intro finite_pcategory_cat_prod_2 𝔄 𝔅)

lemma category_cat_prod_2[cat_cs_intros]: "category Ξ± (𝔄 Γ—C 𝔅)"
  unfolding cat_prod_2_def by (rule pcat_category_cat_prod)

end


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_prod_2_CId_vsv[cat_cs_intros]: "vsv ((𝔄 Γ—C 𝔅)⦇CId⦈)"
  unfolding cat_prod_2_def cat_prod_components by simp

lemma cat_prod_2_CId_vdomain[cat_cs_simps]: 
  "π’Ÿβˆ˜ ((𝔄 Γ—C 𝔅)⦇CId⦈) = (𝔄 Γ—C 𝔅)⦇Obj⦈"
  unfolding cat_prod_2_def cat_prod_components by simp

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

interpretation finite_pcategory Ξ± β€Ή2β„•β€Ί β€Ή(Ξ»i. if i = 0 then 𝔄 else 𝔅)β€Ί
  by (intro finite_pcategory_cat_prod_2 𝔄 𝔅)

lemma cat_prod_2_CId_app[cat_prod_cs_simps]:
  assumes "[a, b]∘ ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
  shows "(𝔄 Γ—C 𝔅)⦇CIdβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡b⦈]∘"
proof-
  have "(𝔄 Γ—C 𝔅)⦇CId⦈ ⦇a, bβ¦ˆβˆ™ = 
    (Ξ»i∈∘2β„•. (if i = 0 then 𝔄 else 𝔅)⦇CIdβ¦ˆβ¦‡[a, b]βˆ˜β¦‡i⦈⦈)"
    by 
      (
        rule 
          cat_prod_CId_app[
            OF assms[unfolded cat_prod_2_def], folded cat_prod_2_def
            ]
      )
  also have 
    "(Ξ»i∈∘2β„•. (if i = 0 then 𝔄 else 𝔅)⦇CIdβ¦ˆβ¦‡[a, b]βˆ˜β¦‡i⦈⦈) = 
      [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡b⦈]∘"
  proof(rule vsv_eqI, unfold vdomain_VLambda)
    fix i assume "i ∈∘ 2β„•"
    then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί unfolding two by auto
    then show 
      "(Ξ»i∈∘2β„•. (if i = 0 then 𝔄 else 𝔅)⦇CIdβ¦ˆβ¦‡[a, b]βˆ˜β¦‡i⦈⦈)⦇i⦈ = 
        [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡b⦈]βˆ˜β¦‡i⦈"
      by cases (simp_all add: two nat_omega_simps)
  qed (auto simp: two nat_omega_simps)
  finally show ?thesis by simp
qed

lemma cat_prod_2_CId_vrange: "β„›βˆ˜ ((𝔄 Γ—C 𝔅)⦇CId⦈) βŠ†βˆ˜ (𝔄 Γ—C 𝔅)⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
  show "vsv ((𝔄 Γ—C 𝔅)⦇CId⦈)" by (rule cat_prod_2_CId_vsv)
  fix ab assume "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
  then obtain a b where ab_def: "ab = [a, b]∘" 
    and a: "a ∈∘ 𝔄⦇Obj⦈" 
    and b: "b ∈∘ 𝔅⦇Obj⦈"
    by (elim cat_prod_2_ObjE[OF 𝔄 𝔅])
  from 𝔄 𝔅 a b show "(𝔄 Γ—C 𝔅)⦇CIdβ¦ˆβ¦‡ab⦈ ∈∘ (𝔄 Γ—C 𝔅)⦇Arr⦈"
    unfolding ab_def 
    by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
qed

end


subsubsectionβ€ΉOpposite product categoryβ€Ί

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

lemma op_smc_smc_prod_2[smc_op_simps]: 
  "op_cat (𝔄 Γ—C 𝔅) = op_cat 𝔄 Γ—C op_cat 𝔅"
proof(rule cat_smc_eqI [of Ξ±])
  from 𝔄 𝔅 show cat_lhs: "category Ξ± (op_cat (𝔄 Γ—C 𝔅))"
    by 
      (
        cs_concl 
          cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
      )
  interpret cat_lhs: category Ξ± β€Ήop_cat (𝔄 Γ—C 𝔅)β€Ί by (rule cat_lhs)
  from 𝔄 𝔅 show cat_rhs: "category Ξ± (op_cat 𝔄 Γ—C op_cat 𝔅)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
      )
  interpret cat_rhs: category Ξ± β€Ήop_cat 𝔄 Γ—C op_cat 𝔅› by (rule cat_rhs)
  show "op_cat (𝔄 Γ—C 𝔅)⦇CId⦈ = (op_cat 𝔄 Γ—C op_cat 𝔅)⦇CId⦈"
    unfolding cat_op_simps
  proof(rule vsv_eqI, unfold cat_cs_simps)
    show "vsv ((𝔄 Γ—C 𝔅)⦇CId⦈)" by (rule cat_prod_2_CId_vsv)
    show "vsv ((op_cat 𝔄 Γ—C op_cat 𝔅)⦇CId⦈)" by (rule cat_prod_2_CId_vsv)
    from 𝔄 𝔅 show "(𝔄 Γ—C 𝔅)⦇Obj⦈ = (op_cat 𝔄 Γ—C op_cat 𝔅)⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros)
    show "(𝔄 Γ—C 𝔅)⦇CIdβ¦ˆβ¦‡ab⦈ = (op_cat 𝔄 Γ—C op_cat 𝔅)⦇CIdβ¦ˆβ¦‡ab⦈"
      if "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈" for ab
      using that unfolding cat_cs_simps
    proof-
      from that obtain a b
        where ab_def: "ab = [a, b]∘" 
          and a: "a ∈∘ 𝔄⦇Obj⦈" 
          and b: "b ∈∘ 𝔅⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF 𝔄 𝔅])
      from 𝔄 𝔅 a b show "(𝔄 Γ—C 𝔅)⦇CIdβ¦ˆβ¦‡ab⦈ = (op_cat 𝔄 Γ—C op_cat 𝔅)⦇CIdβ¦ˆβ¦‡ab⦈"
        unfolding ab_def
        by 
          (
            cs_concl
              cs_simp: cat_op_simps cat_prod_cs_simps
              cs_intro: cat_op_intros cat_prod_cs_intros
          )
    qed
  qed

  from 𝔄 𝔅 show "cat_smc (op_cat (𝔄 Γ—C 𝔅)) = cat_smc (op_cat 𝔄 Γ—C op_cat 𝔅)"
    unfolding slicing_commute[symmetric]
    by (cs_concl cs_simp: smc_op_simps cs_intro: slicing_intros)

qed

end


subsubsectionβ€ΉFlipβ€Ί

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

lemma cat_prod_2_Obj_fconverse[cat_cs_simps]:
  "((𝔄 Γ—C 𝔅)⦇Obj⦈)Β―βˆ™ = (𝔅 Γ—C 𝔄)⦇Obj⦈"
proof-
  interpret fbrelation β€Ή((𝔄 Γ—C 𝔅)⦇Obj⦈)β€Ί 
    by (auto elim: cat_prod_2_ObjE[OF 𝔄 𝔅])
  show ?thesis
  proof(intro vsubset_antisym vsubsetI)
    fix ba assume prems: "ba ∈∘ ((𝔄 Γ—C 𝔅)⦇Obj⦈)Β―βˆ™"
    then obtain a b where ba_def: "ba = [b, a]∘" by clarsimp
    from prems[unfolded ba_def] have "[a, b]∘ ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈" by auto
    then have "a ∈∘ 𝔄⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈"
      by (auto elim: cat_prod_2_ObjE[OF 𝔄 𝔅])
    with 𝔄 𝔅 show "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
      unfolding ba_def by (cs_concl cs_intro: cat_prod_cs_intros)
  next
    fix ba assume "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"  
    then obtain a b 
      where ba_def: "ba = [b, a]∘" 
        and b: "b ∈∘ 𝔅⦇Obj⦈"
        and a: "a ∈∘ 𝔄⦇Obj⦈"
      by (elim cat_prod_2_ObjE[OF 𝔅 𝔄])
    from b a show "ba ∈∘ ((𝔄 Γ—C 𝔅)⦇Obj⦈)Β―βˆ™"
      unfolding ba_def by (auto simp: cat_prod_2_ObjI[OF 𝔄 𝔅 a b])
  qed
qed

lemma cat_prod_2_Arr_fconverse[cat_cs_simps]:
  "((𝔄 Γ—C 𝔅)⦇Arr⦈)Β―βˆ™ = (𝔅 Γ—C 𝔄)⦇Arr⦈"
proof-
  interpret fbrelation β€Ή((𝔄 Γ—C 𝔅)⦇Arr⦈)β€Ί 
    by (auto elim: cat_prod_2_ArrE[OF 𝔄 𝔅])
  show ?thesis
  proof(intro vsubset_antisym vsubsetI)
    fix ba assume prems: "ba ∈∘ ((𝔄 Γ—C 𝔅)⦇Arr⦈)Β―βˆ™"
    then obtain a b where ba_def: "ba = [b, a]∘" by clarsimp
    from prems[unfolded ba_def] have "[a, b]∘ ∈∘ (𝔄 Γ—C 𝔅)⦇Arr⦈" by auto
    then have "a ∈∘ 𝔄⦇Arr⦈" and "b ∈∘ 𝔅⦇Arr⦈"
      by (auto elim: cat_prod_2_ArrE[OF 𝔄 𝔅])
    with 𝔄 𝔅 show "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈"
      unfolding ba_def 
      by 
        (
          cs_concl 
            cs_simp: cat_prod_cs_simps 
            cs_intro: cat_prod_cs_intros cat_cs_intros
        )
  next
    fix ba assume "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈"  
    then obtain a b 
      where ba_def: "ba = [b, a]∘" 
        and b: "b ∈∘ 𝔅⦇Arr⦈"
        and a: "a ∈∘ 𝔄⦇Arr⦈"
      by (elim cat_prod_2_ArrE[OF 𝔅 𝔄])
    from b a show "ba ∈∘ ((𝔄 Γ—C 𝔅)⦇Arr⦈)Β―βˆ™"
      unfolding ba_def by (auto simp: cat_prod_2_ArrI[OF 𝔄 𝔅 a b])
  qed
qed

end



subsectionβ€ΉProjections for the product of two categoriesβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_proj_fst :: "V β‡’ V β‡’ V" (β€ΉΟ€C.1β€Ί)
  where "Ο€C.1 𝔄 𝔅 = cf_proj (2β„•) (Ξ»i. if i = 0 then 𝔄 else 𝔅) 0"
definition cf_proj_snd :: "V β‡’ V β‡’ V" (β€ΉΟ€C.2β€Ί)
  where "Ο€C.2 𝔄 𝔅 = cf_proj (2β„•) (Ξ»i. if i = 0 then 𝔄 else 𝔅) (1β„•)"


textβ€ΉSlicingβ€Ί

lemma cf_smcf_cf_proj_fst[slicing_commute]: 
  "Ο€SMC.1 (cat_smc 𝔄) (cat_smc 𝔅) = cf_smcf (Ο€C.1 𝔄 𝔅)"
  unfolding 
    cf_proj_fst_def smcf_proj_fst_def slicing_commute[symmetric] if_distrib ..

lemma cf_smcf_cf_proj_snd[slicing_commute]: 
  "Ο€SMC.2 (cat_smc 𝔄) (cat_smc 𝔅) = cf_smcf (Ο€C.2 𝔄 𝔅)"
  unfolding 
    cf_proj_snd_def smcf_proj_snd_def slicing_commute[symmetric] if_distrib ..

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

lemmas_with 
  [
    where 𝔄=β€Ήcat_smc 𝔄› and 𝔅=β€Ήcat_smc 𝔅›, 
    unfolded slicing_simps slicing_commute, 
    OF 𝔄.cat_semicategory 𝔅.cat_semicategory
  ]:
  cf_proj_fst_ObjMap_app = smcf_proj_fst_ObjMap_app 
  and cf_proj_snd_ObjMap_app = smcf_proj_snd_ObjMap_app
  and cf_proj_fst_ArrMap_app = smcf_proj_fst_ArrMap_app
  and cf_proj_snd_ArrMap_app = smcf_proj_snd_ArrMap_app

end


subsubsectionβ€Ή
Domain and codomain of a projection of a product of two categories
β€Ί

lemma cf_proj_fst_HomDom: "Ο€C.1 𝔄 𝔅⦇HomDom⦈ = 𝔄 Γ—C 𝔅"
  unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def ..

lemma cf_proj_fst_HomCod: "Ο€C.1 𝔄 𝔅⦇HomCod⦈ = 𝔄"
  unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def by simp
  
lemma cf_proj_snd_HomDom: "Ο€C.2 𝔄 𝔅⦇HomDom⦈ = 𝔄 Γ—C 𝔅"
  unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def ..

lemma cf_proj_snd_HomCod: "Ο€C.2 𝔄 𝔅⦇HomCod⦈ = 𝔅"
  unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def by simp


subsubsectionβ€ΉProjection of a product of two categories is a functorβ€Ί

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝒡 Ξ± by (rule categoryD[OF 𝔄])
interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)
interpretation finite_pcategory Ξ± β€Ή2β„•β€Ί β€Ήif2 𝔄 𝔅›
  by (intro finite_pcategory_cat_prod_2 𝔄 𝔅)

lemma cf_proj_fst_is_functor: 
  assumes "i ∈∘ I" 
  shows "Ο€C.1 𝔄 𝔅 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔄"
  by 
    (
      rule 
        pcat_cf_proj_is_functor[
          where i=0, simplified, folded cf_proj_fst_def cat_prod_2_def
          ]
    )

lemma cf_proj_fst_is_functor'[cat_cs_intros]: 
  assumes "i ∈∘ I" and "β„­ = 𝔄 Γ—C 𝔅" and "𝔇 = 𝔄"
  shows "Ο€C.1 𝔄 𝔅 : β„­ ↦↦CΞ± 𝔇"
  using assms(1) unfolding assms(2,3) by (rule cf_proj_fst_is_functor)

lemma cf_proj_snd_is_functor: 
  assumes "i ∈∘ I" 
  shows "Ο€C.2 𝔄 𝔅 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔅"
  by 
    (
      rule 
        pcat_cf_proj_is_functor[
          where i=β€Ή1β„•β€Ί, simplified, folded cf_proj_snd_def cat_prod_2_def
          ]
    )

lemma cf_proj_snd_is_functor'[cat_cs_intros]: 
  assumes "i ∈∘ I" and "β„­ = 𝔄 Γ—C 𝔅" and "𝔇 = 𝔅"
  shows "Ο€C.2 𝔄 𝔅 : β„­ ↦↦CΞ± 𝔇"
  using assms(1) unfolding assms(2,3) by (rule cf_proj_snd_is_functor)

end



subsectionβ€ΉProduct of three categoriesβ€Ί


subsubsectionβ€ΉDefinition and elementary properties.β€Ί

definition cat_prod_3 :: "V β‡’ V β‡’ V β‡’ V" ("(_ Γ—C3 _ Γ—C3 _)" [81, 81, 81] 80)
  where "𝔄 Γ—C3 𝔅 Γ—C3 β„­ = (∏Ci∈∘3β„•. if3 𝔄 𝔅 β„­ i)"

abbreviation cat_pow_3 :: "V β‡’ V" (β€Ή_^C3β€Ί [81] 80)
  where "β„­^C3 ≑ β„­ Γ—C3 β„­ Γ—C3 β„­"


textβ€ΉSlicing.β€Ί
  
lemma cat_smc_cat_prod_3[slicing_commute]: 
  "cat_smc 𝔄 Γ—SMC3 cat_smc 𝔅 Γ—SMC3 cat_smc β„­ = cat_smc (𝔄 Γ—C3 𝔅 Γ—C3 β„­)"
  unfolding cat_prod_3_def smc_prod_3_def slicing_commute[symmetric] if_distrib
  by (simp add: if_distrib[symmetric])

context 
  fixes Ξ± 𝔄 𝔅 β„­
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅" and β„­: "category Ξ± β„­"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)
interpretation β„­: category Ξ± β„­ by (rule β„­)

lemmas_with 
  [
    where 𝔄=β€Ήcat_smc 𝔄› and 𝔅=β€Ήcat_smc 𝔅› and β„­=β€Ήcat_smc β„­β€Ί, 
    unfolded slicing_simps slicing_commute, 
    OF 𝔄.cat_semicategory 𝔅.cat_semicategory β„­.cat_semicategory
  ]:
  cat_prod_3_ObjI = smc_prod_3_ObjI 
  and cat_prod_3_ObjI'[cat_prod_cs_intros] = smc_prod_3_ObjI'
  and cat_prod_3_ObjE = smc_prod_3_ObjE
  and cat_prod_3_ArrI = smc_prod_3_ArrI
  and cat_prod_3_ArrI'[cat_prod_cs_intros] = smc_prod_3_ArrI'
  and cat_prod_3_ArrE = smc_prod_3_ArrE
  and cat_prod_3_is_arrI = smc_prod_3_is_arrI
  and cat_prod_3_is_arrI'[cat_prod_cs_intros] = smc_prod_3_is_arrI'
  and cat_prod_3_is_arrE = smc_prod_3_is_arrE
  and cat_prod_3_Dom_vsv = smc_prod_3_Dom_vsv
  and cat_prod_3_Dom_vdomain[cat_cs_simps] = smc_prod_3_Dom_vdomain
  and cat_prod_3_Dom_app[cat_prod_cs_simps] = smc_prod_3_Dom_app
  and cat_prod_3_Dom_vrange = smc_prod_3_Dom_vrange
  and cat_prod_3_Cod_vsv = smc_prod_3_Cod_vsv
  and cat_prod_3_Cod_vdomain[cat_cs_simps] = smc_prod_3_Cod_vdomain
  and cat_prod_3_Cod_app[cat_prod_cs_simps] = smc_prod_3_Cod_app
  and cat_prod_3_Cod_vrange = smc_prod_3_Cod_vrange

lemmas_with 
  [
    where 𝔄=β€Ήcat_smc 𝔄› and 𝔅=β€Ήcat_smc 𝔅› and β„­=β€Ήcat_smc β„­β€Ί, 
    unfolded slicing_simps slicing_commute, 
    OF 𝔄.cat_semicategory 𝔅.cat_semicategory β„­.cat_semicategory
  ]:
  cat_prod_3_Comp_app[cat_prod_cs_simps] = smc_prod_3_Comp_app

end


subsubsectionβ€ΉProduct of three categories is a categoryβ€Ί

context 
  fixes Ξ± 𝔄 𝔅 β„­
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅" and β„­: "category Ξ± β„­"
begin

interpretation 𝒡 Ξ± by (rule categoryD[OF 𝔄])
interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)
interpretation β„­: category Ξ± β„­ by (rule β„­)

lemma finite_pcategory_cat_prod_3: "finite_pcategory Ξ± (3β„•) (if3 𝔄 𝔅 β„­)"
proof(intro finite_pcategoryI pcategory_baseI)
  from Axiom_of_Infinity show z1_in_Vset: "3β„• ∈∘ Vset Ξ±" by blast
  show "category Ξ± (if3 𝔄 𝔅 β„­ i)" if "i ∈∘ 3β„•" for i
    by (auto simp: cat_cs_intros)
qed auto

interpretation finite_pcategory Ξ± β€Ή3β„•β€Ί β€Ήif3 𝔄 𝔅 β„­β€Ί
  by (intro finite_pcategory_cat_prod_3 𝔄 𝔅 β„­)

lemma category_cat_prod_3[cat_cs_intros]: "category Ξ± (𝔄 Γ—C3 𝔅 Γ—C3 β„­)"
  unfolding cat_prod_3_def by (rule pcat_category_cat_prod)

end


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_prod_3_CId_vsv[cat_cs_intros]: "vsv ((𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CId⦈)"
  unfolding cat_prod_3_def cat_prod_components by simp

lemma cat_prod_3_CId_vdomain[cat_cs_simps]: 
  "π’Ÿβˆ˜ ((𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CId⦈) = (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈"
  unfolding cat_prod_3_def cat_prod_components by simp

context 
  fixes Ξ± 𝔄 𝔅 β„­
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅" and β„­: "category Ξ± β„­"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)
interpretation β„­: category Ξ± β„­ by (rule β„­)

interpretation finite_pcategory Ξ± β€Ή3β„•β€Ί β€Ήif3 𝔄 𝔅 β„­β€Ί
  by (intro finite_pcategory_cat_prod_3 𝔄 𝔅 β„­)

lemma cat_prod_3_CId_app[cat_prod_cs_simps]:
  assumes "[a, b, c]∘ ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈"
  shows "(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CIdβ¦ˆβ¦‡a, b, cβ¦ˆβˆ™ = [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡b⦈, ℭ⦇CIdβ¦ˆβ¦‡c⦈]∘"
proof-
  have "(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CIdβ¦ˆβ¦‡a, b, cβ¦ˆβˆ™ = 
    (Ξ»i∈∘3β„•. if3 𝔄 𝔅 β„­ i⦇CIdβ¦ˆβ¦‡[a, b, c]βˆ˜β¦‡i⦈⦈)"
    by 
      (
        rule 
          cat_prod_CId_app[
            OF assms[unfolded cat_prod_3_def], folded cat_prod_3_def
            ]
      )
  also have 
    "(Ξ»i∈∘3β„•. if3 𝔄 𝔅 β„­ i⦇CIdβ¦ˆβ¦‡[a, b, c]βˆ˜β¦‡i⦈⦈) = [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡b⦈, ℭ⦇CIdβ¦ˆβ¦‡c⦈]∘"
  proof(rule vsv_eqI, unfold vdomain_VLambda)
    fix i assume "i ∈∘ 3β„•"
    then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί | β€Ήi = 2β„•β€Ί unfolding three by auto
    then show 
      "(Ξ»i∈∘3β„•. (if3 𝔄 𝔅 β„­ i)⦇CIdβ¦ˆβ¦‡[a, b, c]βˆ˜β¦‡i⦈⦈)⦇i⦈ = 
        [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡b⦈, ℭ⦇CIdβ¦ˆβ¦‡c⦈]βˆ˜β¦‡i⦈"
      by cases (simp_all add: three nat_omega_simps)
  qed (auto simp: three nat_omega_simps)
  finally show ?thesis by simp
qed

lemma cat_prod_3_CId_vrange: 
  "β„›βˆ˜ ((𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CId⦈) βŠ†βˆ˜ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
  show "vsv ((𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CId⦈)" by (rule cat_prod_3_CId_vsv)
  fix abc assume "abc ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈"
  then obtain a b c where abc_def: "abc = [a, b, c]∘" 
    and a: "a ∈∘ 𝔄⦇Obj⦈" 
    and b: "b ∈∘ 𝔅⦇Obj⦈"
    and c: "c ∈∘ ℭ⦇Obj⦈"
    by (elim cat_prod_3_ObjE[OF 𝔄 𝔅 β„­])
  from 𝔄 𝔅 β„­ a b c show "(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CIdβ¦ˆβ¦‡abc⦈ ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈"
    unfolding abc_def 
    by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
qed

end



subsectionβ€Ή
Conversion of a product of three categories to products of two categories
β€Ί

definition cf_cat_prod_21_of_3 :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_cat_prod_21_of_3 𝔄 𝔅 β„­ =
    [
      (Ξ»A∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈. [[A⦇0⦈, A⦇1β„•β¦ˆ]∘, A⦇2β„•β¦ˆ]∘),
      (Ξ»F∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈. [[F⦇0⦈, F⦇1β„•β¦ˆ]∘, F⦇2β„•β¦ˆ]∘),
      𝔄 Γ—C3 𝔅 Γ—C3 β„­,
      (𝔄 Γ—C 𝔅) Γ—C β„­
    ]∘"

definition cf_cat_prod_12_of_3 :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_cat_prod_12_of_3 𝔄 𝔅 β„­ =
    [
      (Ξ»A∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈. [A⦇0⦈, [A⦇1β„•β¦ˆ, A⦇2β„•β¦ˆ]∘]∘),
      (Ξ»F∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈. [F⦇0⦈, [F⦇1β„•β¦ˆ, F⦇2β„•β¦ˆ]∘]∘),
      𝔄 Γ—C3 𝔅 Γ—C3 β„­,
      𝔄 Γ—C (𝔅 Γ—C β„­)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_cat_prod_21_of_3_components:
  shows "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMap⦈ =
    (Ξ»A∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈. [[A⦇0⦈, A⦇1β„•β¦ˆ]∘, A⦇2β„•β¦ˆ]∘)"
    and "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ArrMap⦈ =
    (Ξ»F∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈. [[F⦇0⦈, F⦇1β„•β¦ˆ]∘, F⦇2β„•β¦ˆ]∘)"
    and [cat_cs_simps]: "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇HomDom⦈ = 𝔄 Γ—C3 𝔅 Γ—C3 β„­"
    and [cat_cs_simps]: "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇HomCod⦈ = (𝔄 Γ—C 𝔅) Γ—C β„­"
  unfolding cf_cat_prod_21_of_3_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)

lemma cf_cat_prod_12_of_3_components:
  shows "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMap⦈ =
    (Ξ»A∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈. [A⦇0⦈, [A⦇1β„•β¦ˆ, A⦇2β„•β¦ˆ]∘]∘)"
    and "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ArrMap⦈ =
    (Ξ»F∈∘(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈. [F⦇0⦈, [F⦇1β„•β¦ˆ, F⦇2β„•β¦ˆ]∘]∘)"
    and [cat_cs_simps]: "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇HomDom⦈ = 𝔄 Γ—C3 𝔅 Γ—C3 β„­"
    and [cat_cs_simps]: "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇HomCod⦈ = 𝔄 Γ—C (𝔅 Γ—C β„­)"
  unfolding cf_cat_prod_12_of_3_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObjectβ€Ί

mk_VLambda cf_cat_prod_21_of_3_components(1)
  |vsv cf_cat_prod_21_of_3_ObjMap_vsv[cat_cs_intros]|
  |vdomain cf_cat_prod_21_of_3_ObjMap_vdomain[cat_cs_simps]|
  |app cf_cat_prod_21_of_3_ObjMap_app'|

mk_VLambda cf_cat_prod_12_of_3_components(1)
  |vsv cf_cat_prod_12_of_3_ObjMap_vsv[cat_cs_intros]|
  |vdomain cf_cat_prod_12_of_3_ObjMap_vdomain[cat_cs_simps]|
  |app cf_cat_prod_12_of_3_ObjMap_app'|

lemma cf_cat_prod_21_of_3_ObjMap_app[cat_cs_simps]:
  assumes "A = [a, b, c]∘" and "[a, b, c]∘ ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈"
  shows "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡A⦈ = [[a, b]∘, c]∘"
  using assms(2) 
  unfolding assms(1)
  by (simp add: cf_cat_prod_21_of_3_ObjMap_app' nat_omega_simps)

lemma cf_cat_prod_12_of_3_ObjMap_app[cat_cs_simps]:
  assumes "A = [a, b, c]∘" and "[a, b, c]∘ ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈"
  shows "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡A⦈ = [a, [b, c]∘]∘"
  using assms(2)
  unfolding assms(1)
  by (simp add: cf_cat_prod_12_of_3_ObjMap_app' nat_omega_simps)

lemma cf_cat_prod_21_of_3_ObjMap_vrange: 
  assumes "category Ξ± 𝔄" and "category Ξ± 𝔅" and "category Ξ± β„­"
  shows "β„›βˆ˜ (cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMap⦈) βŠ†βˆ˜ ((𝔄 Γ—C 𝔅) Γ—C β„­)⦇Obj⦈"
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret β„­: category Ξ± β„­ by (rule assms(3))
  show ?thesis
  proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_21_of_3_ObjMap_vdomain)
    fix A assume prems: "A ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈"
    then show "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡A⦈ ∈∘ ((𝔄 Γ—C 𝔅) Γ—C β„­)⦇Obj⦈"
      by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_prod_cs_simps 
            cs_intro: cat_cs_intros cat_prod_cs_intros
        )
  qed (cs_concl cs_intro: cat_cs_intros)
qed

lemma cf_cat_prod_12_of_3_ObjMap_vrange: 
  assumes "category Ξ± 𝔄" and "category Ξ± 𝔅" and "category Ξ± β„­"
  shows "β„›βˆ˜ (cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMap⦈) βŠ†βˆ˜ (𝔄 Γ—C (𝔅 Γ—C β„­))⦇Obj⦈"
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret β„­: category Ξ± β„­ by (rule assms(3))
  show ?thesis
  proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_12_of_3_ObjMap_vdomain)
    fix A assume prems: "A ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈"
    then show "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡A⦈ ∈∘ (𝔄 Γ—C (𝔅 Γ—C β„­))⦇Obj⦈"
      by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_prod_cs_simps 
            cs_intro: cat_cs_intros cat_prod_cs_intros
        )
  qed (cs_concl cs_intro: cat_cs_intros)
qed


subsubsectionβ€ΉArrowβ€Ί

mk_VLambda cf_cat_prod_21_of_3_components(2)
  |vsv cf_cat_prod_21_of_3_ArrMap_vsv[cat_cs_intros]|
  |vdomain cf_cat_prod_21_of_3_ArrMap_vdomain[cat_cs_simps]|
  |app cf_cat_prod_21_of_3_ArrMap_app'|

mk_VLambda cf_cat_prod_12_of_3_components(2)
  |vsv cf_cat_prod_12_of_3_ArrMap_vsv[cat_cs_intros]|
  |vdomain cf_cat_prod_12_of_3_ArrMap_vdomain[cat_cs_simps]|
  |app cf_cat_prod_12_of_3_ArrMap_app'|

lemma cf_cat_prod_21_of_3_ArrMap_app[cat_cs_simps]:
  assumes "F = [h, g, f]∘" and "[h, g, f]∘ ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈"
  shows "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡F⦈ = [[h, g]∘, f]∘"
  using assms(2) unfolding assms(1)
  by (simp add: cf_cat_prod_21_of_3_ArrMap_app' nat_omega_simps)

lemma cf_cat_prod_12_of_3_ArrMap_app[cat_cs_simps]:
  assumes "F = [h, g, f]∘" and "[h, g, f]∘ ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Arr⦈"
  shows "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡F⦈ = [h, [g, f]∘]∘"
  using assms(2) 
  unfolding assms(1)
  by (simp add: cf_cat_prod_12_of_3_ArrMap_app' nat_omega_simps)


subsubsectionβ€Ή
Conversion of a product of three categories to products 
of two categories is a functor
β€Ί

lemma cf_cat_prod_21_of_3_is_functor:
  assumes "category Ξ± 𝔄" and "category Ξ± 𝔅" and "category Ξ± β„­"
  shows "cf_cat_prod_21_of_3 𝔄 𝔅 β„­ : 𝔄 Γ—C3 𝔅 Γ—C3 β„­ ↦↦CΞ± (𝔄 Γ—C 𝔅) Γ—C β„­"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret β„­: category Ξ± β„­ by (rule assms(3))

  show ?thesis
  proof(rule is_functorI')
    show "vfsequence (cf_cat_prod_21_of_3 𝔄 𝔅 β„­)"
      unfolding cf_cat_prod_21_of_3_def by auto
    show "vcard (cf_cat_prod_21_of_3 𝔄 𝔅 β„­) = 4β„•"
      unfolding cf_cat_prod_21_of_3_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMap⦈) βŠ†βˆ˜ ((𝔄 Γ—C 𝔅) Γ—C β„­)⦇Obj⦈"
      by (rule cf_cat_prod_21_of_3_ObjMap_vrange[OF assms])
    show 
      "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡F⦈ : 
        cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡A⦈ ↦(𝔄 Γ—C 𝔅) Γ—C β„­ 
        cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡B⦈"
      if "F : A ↦𝔄 Γ—C3 𝔅 Γ—C3 β„­ B"
      for A B F
      using that
      by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
    show 
      "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡G ∘A𝔄 Γ—C3 𝔅 Γ—C3 β„­ F⦈ = 
        cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡G⦈ ∘A(𝔄 Γ—C 𝔅) Γ—C β„­ 
        cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡F⦈"
      if "G : B ↦𝔄 Γ—C3 𝔅 Γ—C3 β„­ C" and "F : A ↦𝔄 Γ—C3 𝔅 Γ—C3 β„­ B"
      for B C G A F
    proof- 
      from that(2) obtain f f' f'' a a' a'' b b' b''
        where F_def: "F = [f, f', f'']∘"
          and A_def: "A = [a, a', a'']∘"
          and B_def: "B = [b, b', b'']∘"
          and f: "f : a ↦𝔄 b"
          and f': "f' : a' ↦𝔅 b'"
          and f'': "f'' : a'' ↦ℭ b''"
        by (elim cat_prod_3_is_arrE[OF assms])
      with that(1) obtain g g' g'' c c' c''
        where G_def: "G = [g, g', g'']∘"
          and C_def: "C = [c, c', c'']∘"
          and g: "g : b ↦𝔄 c"
          and g': "g' : b' ↦𝔅 c'"
          and g'': "g'' : b'' ↦ℭ c''"
        by (auto elim: cat_prod_3_is_arrE[OF assms])
      from that f f' f'' g g' g'' show ?thesis
        unfolding F_def A_def B_def G_def C_def
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_prod_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
    show 
      "cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CIdβ¦ˆβ¦‡C⦈⦈ =
        ((𝔄 Γ—C 𝔅) Γ—C β„­)⦇CIdβ¦ˆβ¦‡cf_cat_prod_21_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡C⦈⦈"
      if "C ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈" for C
      using that 
      by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_prod_cs_simps 
            cs_intro: cat_cs_intros cat_prod_cs_intros
        )
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

qed

lemma cf_cat_prod_21_of_3_is_functor'[cat_cs_intros]:
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "category Ξ± β„­"
    and "𝔄' = 𝔄 Γ—C3 𝔅 Γ—C3 β„­"
    and "𝔅' = (𝔄 Γ—C 𝔅) Γ—C β„­"
  shows "cf_cat_prod_21_of_3 𝔄 𝔅 β„­ : 𝔄' ↦↦CΞ± 𝔅'"
  using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_21_of_3_is_functor)

lemma cf_cat_prod_12_of_3_is_functor:
  assumes "category Ξ± 𝔄" and "category Ξ± 𝔅" and "category Ξ± β„­"
  shows "cf_cat_prod_12_of_3 𝔄 𝔅 β„­ : 𝔄 Γ—C3 𝔅 Γ—C3 β„­ ↦↦CΞ± 𝔄 Γ—C (𝔅 Γ—C β„­)"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret β„­: category Ξ± β„­ by (rule assms(3))

  show ?thesis
  proof(rule is_functorI')
    show "vfsequence (cf_cat_prod_12_of_3 𝔄 𝔅 β„­)"
      unfolding cf_cat_prod_12_of_3_def by auto
    show "vcard (cf_cat_prod_12_of_3 𝔄 𝔅 β„­) = 4β„•"
      unfolding cf_cat_prod_12_of_3_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMap⦈) βŠ†βˆ˜ (𝔄 Γ—C (𝔅 Γ—C β„­))⦇Obj⦈"
      by (rule cf_cat_prod_12_of_3_ObjMap_vrange[OF assms])
    show 
      "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡F⦈ :
        cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡A⦈ ↦𝔄 Γ—C (𝔅 Γ—C β„­) 
        cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡B⦈"
      if "F : A ↦𝔄 Γ—C3 𝔅 Γ—C3 β„­ B"
      for A B F
      using that
      by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
    show 
      "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡G ∘A𝔄 Γ—C3 𝔅 Γ—C3 β„­ F⦈ = 
        cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡G⦈ ∘A𝔄 Γ—C (𝔅 Γ—C β„­) 
        cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡F⦈"
      if "G : B ↦𝔄 Γ—C3 𝔅 Γ—C3 β„­ C" and "F : A ↦𝔄 Γ—C3 𝔅 Γ—C3 β„­ B"
      for B C G A F
    proof- 
      from that(2) obtain f f' f'' a a' a'' b b' b''
        where F_def: "F = [f, f', f'']∘"
          and A_def: "A = [a, a', a'']∘"
          and B_def: "B = [b, b', b'']∘"
          and f: "f : a ↦𝔄 b"
          and f': "f' : a' ↦𝔅 b'"
          and f'': "f'' : a'' ↦ℭ b''"
        by (elim cat_prod_3_is_arrE[OF assms])
      with that(1) obtain g g' g'' c c' c''
        where G_def: "G = [g, g', g'']∘"
          and C_def: "C = [c, c', c'']∘"
          and g: "g : b ↦𝔄 c"
          and g': "g' : b' ↦𝔅 c'"
          and g'': "g'' : b'' ↦ℭ c''"
        by (auto elim: cat_prod_3_is_arrE[OF assms])
      from that f f' f'' g g' g'' show ?thesis
        unfolding F_def A_def B_def G_def C_def
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_prod_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
    show 
      "cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡(𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇CIdβ¦ˆβ¦‡C⦈⦈ =
        (𝔄 Γ—C (𝔅 Γ—C β„­))⦇CIdβ¦ˆβ¦‡cf_cat_prod_12_of_3 𝔄 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡C⦈⦈"
      if "C ∈∘ (𝔄 Γ—C3 𝔅 Γ—C3 β„­)⦇Obj⦈" for C
      using that 
      by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_prod_cs_simps 
            cs_intro: cat_cs_intros cat_prod_cs_intros
        )
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

qed

lemma cf_cat_prod_12_of_3_is_functor'[cat_cs_intros]:
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "category Ξ± β„­"
    and "𝔄' = 𝔄 Γ—C3 𝔅 Γ—C3 β„­"
    and "𝔅' = 𝔄 Γ—C (𝔅 Γ—C β„­)"
  shows "cf_cat_prod_12_of_3 𝔄 𝔅 β„­ : 𝔄' ↦↦CΞ± 𝔅'"
  using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_12_of_3_is_functor)



subsectionβ€ΉBifunctorsβ€Ί

textβ€Ή
A bifunctor is defined as a functor from a product of two categories
to a category (see Chapter II-3 in \cite{mac_lane_categories_2010}).
This subsection exposes the elementary properties of the projections of the 
bifunctors established by fixing an argument in a functor (see Chapter II-3 
in \cite{mac_lane_categories_2010} for further information).
β€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί

definition bifunctor_proj_fst :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  (β€Ή(_β‡˜_,_⇙/'(/-,_/')/CF)β€Ί [51, 51, 51, 51] 51)
  where "𝔖𝔄,𝔅(-,b)CF =
    (π”–βˆCi∈∘2β„• -∘ set {1β„•}. (i = 0 ? 𝔄 : 𝔅),𝔖⦇HomCod⦈(-,set {⟨1β„•, b⟩})) ∘CF
      cf_singleton 0 𝔄"

definition bifunctor_proj_snd :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  (β€Ή(_β‡˜_,_⇙/'(/_,-/')/CF)β€Ί [51, 51, 51, 51] 51)
  where "𝔖𝔄,𝔅(a,-)CF =
    (π”–βˆCi∈∘2β„• -∘ set {0}. (i = 0 ? 𝔄 : 𝔅),𝔖⦇HomCod⦈(-,set {⟨0, a⟩})) ∘CF
      cf_singleton (1β„•) 𝔅"

abbreviation bcf_ObjMap_app :: "V β‡’ V β‡’ V β‡’ V" (infixl "βŠ—HM.OΔ±" 55)
  where "a βŠ—HM.O𝔖 b ≑ 𝔖⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
abbreviation bcf_ArrMap_app :: "V β‡’ V β‡’ V β‡’ V" (infixl "βŠ—HM.AΔ±" 55)
  where "g βŠ—HM.A𝔖 f ≑ 𝔖⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™"


textβ€ΉElementary properties.β€Ί

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)
interpretation finite_pcategory Ξ± β€Ή2β„•β€Ί β€Ήif2 𝔄 𝔅›
  by (intro finite_pcategory_cat_prod_2 𝔄 𝔅)

lemma cat_singleton_qm_fst_def[simp]: 
  "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅)) = (∏Ci∈∘set {0}. 𝔄)"
proof(rule cat_eqI[of Ξ±])
  show "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Obj⦈ = (∏Ci∈∘set {0}. 𝔄)⦇Obj⦈"
    unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
  show [simp]: "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Arr⦈ = (∏Ci∈∘set {0}. 𝔄)⦇Arr⦈"
    unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
  show [simp]: "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Dom⦈ = (∏Ci∈∘set {0}. 𝔄)⦇Dom⦈"
    unfolding cat_prod_components 
    by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
  show [simp]: 
    "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Cod⦈ = (∏Ci∈∘set {0}. 𝔄)⦇Cod⦈"
    unfolding cat_prod_components 
    by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
  have [simp]: 
    "f : a β†¦βˆCi∈∘set {0}. (i = 0 ? 𝔄 : 𝔅) b ⟷ 
      f : a β†¦βˆCi∈∘set {0}. 𝔄 b"
    for f a b
    unfolding is_arr_def by simp
  show "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈ = (∏Ci∈∘set {0}. 𝔄)⦇Comp⦈"
  proof(rule vsv_eqI)
    show "vsv ((∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈)"
      unfolding cat_prod_components by simp
    show "vsv ((∏Ci∈∘set {0}. 𝔄)⦇Comp⦈)"
      unfolding cat_prod_components by simp
    show "π’Ÿβˆ˜ ((∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈) = 
      π’Ÿβˆ˜ ((∏Ci∈∘set {0}. 𝔄)⦇Comp⦈)"
      by (simp add: composable_arrs_def cat_cs_simps)
    show "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Compβ¦ˆβ¦‡gf⦈ = 
      (∏Ci∈∘set {0}. 𝔄)⦇Compβ¦ˆβ¦‡gf⦈"
      if "gf ∈∘ π’Ÿβˆ˜ ((∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈)" for gf
    proof-
      from that have "gf ∈∘ composable_arrs (∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))"
        by (simp add: cat_cs_simps)
      then obtain g f a b c where gf_def: "gf = [g, f]∘" 
        and g: "g : b ↦(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅)) c" 
        and f: "f : a ↦(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅)) b"
        by clarsimp
      then have g': "g : b ↦(∏Ci∈∘set {0}. 𝔄) c" 
        and f': "f : a ↦(∏Ci∈∘set {0}. 𝔄) b"
        by simp_all
      show ?thesis
        unfolding gf_def
        unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
        by (subst (1 2) VLambda_vsingleton_def) simp
    qed
  qed
  show "(∏Ci∈∘set {0}. (i = 0 ? 𝔄 : 𝔅))⦇CId⦈ = (∏Ci∈∘set {0}. 𝔄)⦇CId⦈"
    unfolding cat_prod_components 
    by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp    
qed 
  (
    simp_all add: 
      𝔄.cat_category_cat_singleton
      pcategory.pcat_category_cat_prod 
      pcat_vsubset_index_pcategory 
      vsubset_vsingleton_leftI
  )

lemma cat_singleton_qm_snd_def[simp]: 
  "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅)) = (∏Ci∈∘set {1β„•}. 𝔅)"
proof(rule cat_eqI[of Ξ±])
  show "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Obj⦈ = (∏Ci∈∘set {1β„•}. 𝔅)⦇Obj⦈"
    unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
  show [simp]: 
    "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Arr⦈ = (∏Ci∈∘set {1β„•}. 𝔅)⦇Arr⦈"
    unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
  show [simp]: 
    "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Dom⦈ = (∏Ci∈∘set {1β„•}. 𝔅)⦇Dom⦈"
    unfolding cat_prod_components 
    by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
  show [simp]: 
    "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Cod⦈ = (∏Ci∈∘set {1β„•}. 𝔅)⦇Cod⦈"
    unfolding cat_prod_components 
    by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
  have [simp]: "f : a β†¦βˆCi∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅) b ⟷ 
    f : a β†¦βˆCi∈∘set {1β„•}. 𝔅 b"
    for f a b
    unfolding is_arr_def by simp
  show "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈ = (∏Ci∈∘set {1β„•}. 𝔅)⦇Comp⦈"
  proof(rule vsv_eqI)
    show "vsv ((∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈)"
      unfolding cat_prod_components by simp
    show "vsv ((∏Ci∈∘set {1β„•}. 𝔅)⦇Comp⦈)"
      unfolding cat_prod_components by simp
    show "π’Ÿβˆ˜ ((∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈) = 
      π’Ÿβˆ˜ ((∏Ci∈∘set {1β„•}. 𝔅)⦇Comp⦈)"
      by (simp add: composable_arrs_def cat_cs_simps)
    show "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Compβ¦ˆβ¦‡gf⦈ = 
      (∏Ci∈∘set {1β„•}. 𝔅)⦇Compβ¦ˆβ¦‡gf⦈"
      if "gf ∈∘ π’Ÿβˆ˜ ((∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇Comp⦈)" for gf
    proof-
      from that have "gf ∈∘ composable_arrs (∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))"
        by (simp add: cat_cs_simps)
      then obtain g f a b c where gf_def: "gf = [g, f]∘" 
        and g: "g : b ↦(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅)) c" 
        and f: "f : a ↦(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅)) b"
        by clarsimp
      then have g': "g : b ↦(∏Ci∈∘set {1β„•}. 𝔅) c" 
        and f': "f : a ↦(∏Ci∈∘set {1β„•}. 𝔅) b"
        by simp_all
      show ?thesis
        unfolding gf_def
        unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
        by (subst (1 2) VLambda_vsingleton_def) simp
    qed
  qed
  show "(∏Ci∈∘set {1β„•}. (i = 0 ? 𝔄 : 𝔅))⦇CId⦈ = (∏Ci∈∘set {1β„•}. 𝔅)⦇CId⦈"
    unfolding cat_prod_components 
    by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp    
qed 
  (
    simp_all add: 
      𝔅.cat_category_cat_singleton
      pcategory.pcat_category_cat_prod 
      pcat_vsubset_index_pcategory 
      vsubset_vsingleton_leftI
  )

end


subsubsectionβ€ΉObject mapβ€Ί

context
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

interpretation finite_pcategory Ξ± β€Ή2β„•β€Ί β€Ήif2 𝔄 𝔅›
  by (intro finite_pcategory_cat_prod_2 𝔄 𝔅)

lemmas_with [OF 𝔄.category_axioms 𝔅.category_axioms, simp]:
  cat_singleton_qm_fst_def and cat_singleton_qm_snd_def

lemma bifunctor_proj_fst_ObjMap_app[cat_cs_simps]:
  assumes "[a, b]∘ ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
  shows "(𝔖𝔄,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔖⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
proof-

  let ?𝔇 = ‹𝔖⦇HomCodβ¦ˆβ€Ί
  let ?𝔖 = β€Ήπ”–βˆCi∈∘2β„•-∘set {1β„•}.(i = 0 ? 𝔄 : 𝔅),?𝔇(-,set {⟨1β„•, b⟩})β€Ί
  let ?cfs = β€Ήcf_singleton 0 𝔄›

  from assms have a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈"
    by (allβ€Ήelim cat_prod_2_ObjE[OF 𝔄 𝔅]β€Ί) auto

  from a have za: "set {⟨0, a⟩} ∈∘ (∏Ci∈∘set {0}. 𝔄)⦇Obj⦈"
    by (intro cat_singleton_ObjI[where a=a]) simp
  have [simp]: "vinsert ⟨0, a⟩ (set {⟨1β„•, b⟩}) = [a, b]∘"
    using ord_of_nat_succ_vempty unfolding vcons_def by auto

  have "(𝔖𝔄,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈ = (?𝔖⦇ObjMap⦈ ∘∘ ?cfs⦇ObjMap⦈)⦇a⦈"
    unfolding bifunctor_proj_fst_def dghm_comp_components by simp
  also have "… = ?𝔖⦇ObjMapβ¦ˆβ¦‡?cfs⦇ObjMapβ¦ˆβ¦‡a⦈⦈"
    by (rule vsv_vcomp_at)
      (
        simp_all add:
          two a za
          cf_singleton_components 
          prodfunctor_proj_components 
          cf_singleton_ObjMap_app 
          
      ) 
  also from za have "… = 𝔖⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™" 
    unfolding two cf_singleton_ObjMap_app[OF a] prodfunctor_proj_components 
    by simp
  finally show ?thesis by simp

qed

lemma bifunctor_proj_snd_ObjMap_app[cat_cs_simps]:
  assumes "[a, b]∘ ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
  shows "(𝔖𝔄,𝔅(a,-)CF)⦇ObjMapβ¦ˆβ¦‡b⦈ = 𝔖⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
proof-

  let ?𝔇 = ‹𝔖⦇HomCodβ¦ˆβ€Ί
  let ?𝔖 = β€Ήπ”–βˆCi∈∘2β„•-∘set {0}.(i = 0 ? 𝔄 : 𝔅),?𝔇(-,set {⟨0, a⟩})β€Ί
  let ?cfs = β€Ήcf_singleton (1β„•) 𝔅›

  from assms have a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈"
    by (allβ€Ήelim cat_prod_2_ObjE[OF 𝔄 𝔅]β€Ί) auto
  from a have za: "set {⟨0, a⟩} ∈∘ (∏Ci∈∘set {0}. 𝔄)⦇Obj⦈"
    by (intro cat_singleton_ObjI[where a=a]) simp
  from b have ob: "set {⟨1β„•, b⟩} ∈∘ (∏Ci∈∘set {1β„•}. 𝔅)⦇Obj⦈"
    by (intro cat_singleton_ObjI[where a=b]) simp
  have[simp]: "vinsert ⟨1β„•, b⟩ (set {⟨0, a⟩}) = [a, b]∘"
    using ord_of_nat_succ_vempty unfolding vcons_def by auto

  have "(𝔖𝔄,𝔅(a,-)CF)⦇ObjMapβ¦ˆβ¦‡b⦈ = (?𝔖⦇ObjMap⦈ ∘∘ ?cfs⦇ObjMap⦈)⦇b⦈"
    unfolding bifunctor_proj_snd_def dghm_comp_components by simp
  also have "… = ?𝔖⦇ObjMapβ¦ˆβ¦‡?cfs⦇ObjMapβ¦ˆβ¦‡b⦈⦈"
    by (rule vsv_vcomp_at)
      (
        simp_all add: 
          two
          cf_singleton_components 
          prodfunctor_proj_components 
          cf_singleton_ObjMap_app 
          ob b
      ) 
  also from ob have "… = 𝔖⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™" 
    unfolding two cf_singleton_ObjMap_app[OF b] prodfunctor_proj_components 
    by simp
  finally show ?thesis by simp

qed

end


subsubsectionβ€ΉArrow mapβ€Ί

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

interpretation finite_pcategory Ξ± β€Ή2β„•β€Ί β€Ήif2 𝔄 𝔅›
  by (intro finite_pcategory_cat_prod_2 𝔄 𝔅)

lemmas_with [OF 𝔄.category_axioms 𝔅.category_axioms, simp]:
  cat_singleton_qm_fst_def and cat_singleton_qm_snd_def

lemma bifunctor_proj_fst_ArrMap_app[cat_cs_simps]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "f ∈∘ 𝔄⦇Arr⦈"
  shows "(𝔖𝔄,𝔅(-,b)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔖⦇ArrMapβ¦ˆβ¦‡f, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
proof-

  let ?𝔇 = ‹𝔖⦇HomCodβ¦ˆβ€Ί
  let ?𝔖 = β€Ήπ”–βˆCi∈∘2β„•-∘set {1β„•}.(i = 0 ? 𝔄 : 𝔅),?𝔇(-,set {⟨1β„•, b⟩})β€Ί
  let ?cfs = β€Ήcf_singleton 0 𝔄›

  from assms(1) have "𝔅⦇CIdβ¦ˆβ¦‡b⦈ : b ↦𝔅 b" by (auto intro: cat_cs_intros)
  then have CId_b: "𝔅⦇CIdβ¦ˆβ¦‡b⦈ ∈∘ 𝔅⦇Arr⦈" by auto

  from assms(2) have zf: "set {⟨0, f⟩} ∈∘ (∏Ci∈∘set {0}. 𝔄)⦇Arr⦈"
    by (intro cat_singleton_ArrI[where a=f]) simp
  from assms(1) have ob: "set {⟨1β„•, b⟩} ∈∘ (∏Ci∈∘set {1β„•}. 𝔅)⦇Obj⦈"
    by (intro cat_singleton_ObjI[where a=b]) simp
  have [simp]: "vinsert ⟨0, f⟩ (set {⟨1β„•, 𝔅⦇CIdβ¦ˆβ¦‡b⦈⟩}) = [f, 𝔅⦇CIdβ¦ˆβ¦‡b⦈]∘"
    using ord_of_nat_succ_vempty unfolding vcons_def by auto

  have "(𝔖𝔄,𝔅(-,b)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ = (?𝔖⦇ArrMap⦈ ∘∘ ?cfs⦇ArrMap⦈)⦇f⦈"
    unfolding bifunctor_proj_fst_def dghm_comp_components by simp
  also have "… = ?𝔖⦇ArrMapβ¦ˆβ¦‡?cfs⦇ArrMapβ¦ˆβ¦‡f⦈⦈"
    by (rule vsv_vcomp_at)
      (
        simp_all add:
          two
          assms(2)
          cf_singleton_components
          prodfunctor_proj_components
          cf_singleton_ArrMap_app 
          zf
      )   
  also from assms(1) zf have "… = 𝔖⦇ArrMapβ¦ˆβ¦‡f, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™" 
    unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components 
    by (simp add: two cat_singleton_CId_app[OF ob])
  finally show ?thesis by simp

qed

lemma bifunctor_proj_snd_ArrMap_app[cat_cs_simps]:
  assumes "a ∈∘ 𝔄⦇Obj⦈" and "g ∈∘ 𝔅⦇Arr⦈" 
  shows "(𝔖𝔄,𝔅(a,-)CF)⦇ArrMapβ¦ˆβ¦‡g⦈ = 𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a⦈, gβ¦ˆβˆ™"
proof-

  let ?𝔇 = ‹𝔖⦇HomCodβ¦ˆβ€Ί
  let ?𝔖 = β€Ήπ”–βˆCi∈∘2β„•-∘set {0}.(i = 0 ? 𝔄 : 𝔅),?𝔇(-,set {⟨0, a⟩})β€Ί
  let ?cfs = β€Ήcf_singleton (1β„•) 𝔅›

  from assms(1) have "𝔄⦇CIdβ¦ˆβ¦‡a⦈ : a ↦𝔄 a" by (auto intro: cat_cs_intros)
  then have CId_a: "𝔄⦇CIdβ¦ˆβ¦‡a⦈ ∈∘ 𝔄⦇Arr⦈" by auto

  from assms(2) have og: "set {⟨1β„•, g⟩} ∈∘ (∏Ci∈∘set {1β„•}. 𝔅)⦇Arr⦈"
    by (intro cat_singleton_ArrI[where a=g]) simp
  from assms(1) have ob: "set {⟨0, a⟩} ∈∘ (∏Ci∈∘set {0}. 𝔄)⦇Obj⦈"
    by (intro cat_singleton_ObjI[where a=a]) simp
  have [simp]: "vinsert ⟨1β„•, g⟩ (set {⟨0, 𝔄⦇CIdβ¦ˆβ¦‡a⦈⟩}) = [𝔄⦇CIdβ¦ˆβ¦‡a⦈, g]∘"
    using ord_of_nat_succ_vempty unfolding vcons_def by auto

  have "(𝔖𝔄,𝔅(a,-)CF)⦇ArrMapβ¦ˆβ¦‡g⦈ = (?𝔖⦇ArrMap⦈ ∘∘ ?cfs⦇ArrMap⦈)⦇g⦈"
    unfolding two bifunctor_proj_snd_def dghm_comp_components by simp
  also have "… = ?𝔖⦇ArrMapβ¦ˆβ¦‡?cfs⦇ArrMapβ¦ˆβ¦‡g⦈⦈"
    by (rule vsv_vcomp_at)
      (
        simp_all add:
          two
          assms(2) 
          cf_singleton_components 
          prodfunctor_proj_components 
          cf_singleton_ArrMap_app 
          og
      )   
  also from assms(1) og have "… = 𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a⦈, gβ¦ˆβˆ™" 
    unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components 
    by (simp add: two cat_singleton_CId_app[OF ob])
  finally show ?thesis by simp

qed

end


subsubsectionβ€ΉBifunctor projections are functorsβ€Ί

context 
  fixes Ξ± 𝔄 𝔅
  assumes 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅"
begin

interpretation 𝔄: category Ξ± 𝔄 by (rule 𝔄)
interpretation 𝔅: category Ξ± 𝔅 by (rule 𝔅)

interpretation finite_pcategory Ξ± β€Ή2β„•β€Ί β€Ήif2 𝔄 𝔅›
  by (intro finite_pcategory_cat_prod_2 𝔄 𝔅)

lemmas_with [OF 𝔄.category_axioms 𝔅.category_axioms, simp]:
  cat_singleton_qm_fst_def and cat_singleton_qm_snd_def

lemma bifunctor_proj_fst_is_functor:
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝔖𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± 𝔇"
proof-

  interpret 𝔖: is_functor Ξ± ‹𝔄 Γ—C 𝔅› 𝔇 𝔖 by (rule assms(1))

  show ?thesis
    unfolding bifunctor_proj_fst_def
  proof
    (
      intro cf_comp_is_functorI[where 𝔅=β€Ή(∏Ci∈∘set {0}. 𝔄)β€Ί], 
      unfold 𝔖.cf_HomCod
    )
    from assms(2) have zb: 
      "set {⟨1β„•, b⟩} ∈∘ (∏Cj∈∘set {1β„•}. if j = 0 then 𝔄 else 𝔅)⦇Obj⦈"
      unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
    have o_zo: "set {1β„•} βŠ†βˆ˜ 2β„•" by clarsimp
    from pcat_prodfunctor_proj_is_functor[
        folded cat_prod_2_def, where J=β€Ήset {1β„•}β€Ί, OF assms(1) zb o_zo
        ]
    show "π”–βˆCi∈∘2β„•-∘set {1β„•}.(i = 0 ? 𝔄 : 𝔅),𝔇(-,set {⟨1β„•, b⟩}) :
      (∏Ci∈∘set {0}. 𝔄) ↦↦CΞ± 𝔇"
      unfolding two by simp
    from category.cat_cf_singleton_is_functor[OF 𝔄.category_axioms, of 0] show 
      "cf_singleton 0 𝔄 : 𝔄 ↦↦CΞ± (∏Ci∈∘set {0}. 𝔄)"
      by force
  qed

qed

lemma bifunctor_proj_fst_is_functor'[cat_cs_intros]:
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "b ∈∘ 𝔅⦇Obj⦈" and "𝔄' = 𝔄"
  shows "𝔖𝔄,𝔅(-,b)CF : 𝔄' ↦↦CΞ± 𝔇"
  using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_fst_is_functor)

lemma bifunctor_proj_fst_ObjMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "vsv ((𝔖𝔄,𝔅(-,b)CF)⦇ObjMap⦈)"
proof-
  interpret 𝔖: is_functor Ξ± 𝔄 𝔇 ‹𝔖𝔄,𝔅(-,b)CFβ€Ί
    by (rule bifunctor_proj_fst_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ObjMap_vsv)
qed

lemma bifunctor_proj_fst_ObjMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "π’Ÿβˆ˜ ((𝔖𝔄,𝔅(-,b)CF)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
proof-
  interpret 𝔖: is_functor Ξ± 𝔄 𝔇 ‹𝔖𝔄,𝔅(-,b)CFβ€Ί
    by (rule bifunctor_proj_fst_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ObjMap_vdomain)
qed

lemma bifunctor_proj_fst_ArrMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "vsv ((𝔖𝔄,𝔅(-,b)CF)⦇ArrMap⦈)"
proof-
  interpret 𝔖: is_functor Ξ± 𝔄 𝔇 ‹𝔖𝔄,𝔅(-,b)CFβ€Ί
    by (rule bifunctor_proj_fst_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ArrMap_vsv)
qed

lemma bifunctor_proj_fst_ArrMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "π’Ÿβˆ˜ ((𝔖𝔄,𝔅(-,b)CF)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
proof-
  interpret 𝔖: is_functor Ξ± 𝔄 𝔇 ‹𝔖𝔄,𝔅(-,b)CFβ€Ί
    by (rule bifunctor_proj_fst_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ArrMap_vdomain)
qed

lemma bifunctor_proj_snd_is_functor:
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "a ∈∘ 𝔄⦇Obj⦈"
  shows "𝔖𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± 𝔇"
proof-

  interpret 𝔖: is_functor Ξ± ‹𝔄 Γ—C 𝔅› 𝔇 𝔖 by (rule assms(1))

  show ?thesis
    unfolding bifunctor_proj_snd_def
  proof
    (
      intro cf_comp_is_functorI[where 𝔅=β€Ή(∏Ci∈∘set {1β„•}. 𝔅)β€Ί], 
      unfold 𝔖.cf_HomCod
    )
    from assms(2) have zb: 
      "set {⟨0, a⟩} ∈∘ (∏Cj∈∘set {0}. if j = 0 then 𝔄 else 𝔅)⦇Obj⦈"
      unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
    have o_zo: "set {0} βŠ†βˆ˜ 2β„•" by clarsimp
    from 
      pcat_prodfunctor_proj_is_functor[
        folded cat_prod_2_def, where J=β€Ήset {0}β€Ί, OF assms(1) zb o_zo
        ]
    show "π”–βˆCi∈∘2β„•-∘set {0}.(i = 0 ? 𝔄 : 𝔅),𝔇(-,set {⟨0, a⟩}) :
      (∏Ci∈∘set {1β„•}. 𝔅) ↦↦CΞ± 𝔇"
      unfolding two by simp
    from category.cat_cf_singleton_is_functor[OF 𝔅.category_axioms, of β€Ή1β„•β€Ί] 
    show "cf_singleton (1β„•) 𝔅 : 𝔅 ↦↦CΞ± (∏Ci∈∘set {1β„•}. 𝔅)"
      by force
  qed

qed

lemma bifunctor_proj_snd_is_functor'[cat_cs_intros]:
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "a ∈∘ 𝔄⦇Obj⦈" and "𝔅' = 𝔅"
  shows "𝔖𝔄,𝔅(a,-)CF : 𝔅' ↦↦CΞ± 𝔇"
  using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_snd_is_functor)

lemma bifunctor_proj_snd_ObjMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "a ∈∘ 𝔄⦇Obj⦈"
  shows "vsv ((𝔖𝔄,𝔅(a,-)CF)⦇ObjMap⦈)"
proof-
  interpret 𝔖: is_functor Ξ± 𝔅 𝔇 ‹𝔖𝔄,𝔅(a,-)CFβ€Ί
    by (rule bifunctor_proj_snd_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ObjMap_vsv)
qed

lemma bifunctor_proj_snd_ObjMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "a ∈∘ 𝔄⦇Obj⦈"
  shows "π’Ÿβˆ˜ ((𝔖𝔄,𝔅(a,-)CF)⦇ObjMap⦈) = 𝔅⦇Obj⦈"
proof-
  interpret 𝔖: is_functor Ξ± 𝔅 𝔇 ‹𝔖𝔄,𝔅(a,-)CFβ€Ί
    by (rule bifunctor_proj_snd_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ObjMap_vdomain)
qed

lemma bifunctor_proj_snd_ArrMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "a ∈∘ 𝔄⦇Obj⦈"
  shows "vsv ((𝔖𝔄,𝔅(a,-)CF)⦇ArrMap⦈)"
proof-
  interpret 𝔖: is_functor Ξ± 𝔅 𝔇 ‹𝔖𝔄,𝔅(a,-)CFβ€Ί
    by (rule bifunctor_proj_snd_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ArrMap_vsv)
qed

lemma bifunctor_proj_snd_ArrMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± 𝔇" and "a ∈∘ 𝔄⦇Obj⦈"
  shows "π’Ÿβˆ˜ ((𝔖𝔄,𝔅(a,-)CF)⦇ArrMap⦈) = 𝔅⦇Arr⦈"
proof-
  interpret 𝔖: is_functor Ξ± 𝔅 𝔇 ‹𝔖𝔄,𝔅(a,-)CFβ€Ί
    by (rule bifunctor_proj_snd_is_functor[OF assms])
  show ?thesis by (rule 𝔖.cf_ArrMap_vdomain)
qed

end



subsectionβ€ΉBifunctor flipβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition bifunctor_flip :: "V β‡’ V β‡’ V β‡’ V"
  where "bifunctor_flip 𝔄 𝔅 𝔉 =
    [fflip (𝔉⦇ObjMap⦈), fflip (𝔉⦇ArrMap⦈), 𝔅 Γ—C 𝔄, 𝔉⦇HomCod⦈]∘"


textβ€ΉComponentsβ€Ί

lemma bifunctor_flip_components:
  shows "bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈ = fflip (𝔉⦇ObjMap⦈)"
    and "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈ = fflip (𝔉⦇ArrMap⦈)"
    and "bifunctor_flip 𝔄 𝔅 𝔉⦇HomDom⦈ = 𝔅 Γ—C 𝔄"
    and "bifunctor_flip 𝔄 𝔅 𝔉⦇HomCod⦈ = 𝔉⦇HomCod⦈"
  unfolding bifunctor_flip_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉBifunctor flip object mapβ€Ί

lemma bifunctor_flip_ObjMap_vsv[cat_cs_intros]: 
  "vsv (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈)"
  unfolding bifunctor_flip_components by (rule fflip_vsv)

lemma bifunctor_flip_ObjMap_app:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b, aβ¦ˆβˆ™ = 𝔉⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
  using assms
  unfolding bifunctor_flip_components assms(4,5)
  by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)

lemma bifunctor_flip_ObjMap_app'[cat_cs_simps]:
  assumes "ba = [b, a]∘"
    and "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡ba⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
  using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ObjMap_app)

lemma bifunctor_flip_ObjMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) = (𝔅 Γ—C 𝔄)⦇Obj⦈"
  using assms
  unfolding bifunctor_flip_components 
  by (cs_concl cs_simp: V_cs_simps cat_cs_simps)

lemma bifunctor_flip_ObjMap_vrange[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) = β„›βˆ˜ (𝔉⦇ObjMap⦈)"
proof-
  
  interpret 𝔉: is_functor Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔉 by (rule assms(3))

  show ?thesis
  proof(intro vsubset_antisym)

    show "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) βŠ†βˆ˜ β„›βˆ˜ (𝔉⦇ObjMap⦈)"
    proof
      (
        intro vsv.vsv_vrange_vsubset, 
        unfold bifunctor_flip_ObjMap_vdomain[OF assms]
      )
      fix ba assume "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
      then obtain a b
        where ba_def: "ba = [b, a]∘" 
          and b: "b ∈∘ 𝔅⦇Obj⦈" 
          and a: "a ∈∘ 𝔄⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF assms(2,1)])
      from assms a b show 
        "bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡ba⦈ ∈∘ β„›βˆ˜ (𝔉⦇ObjMap⦈)"
        unfolding ba_def
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
          )
    qed (auto intro: cat_cs_intros)

    show "β„›βˆ˜ (𝔉⦇ObjMap⦈) βŠ†βˆ˜ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈)"
    proof(intro vsv.vsv_vrange_vsubset, unfold 𝔉.cf_ObjMap_vdomain)
      fix ab assume prems: "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
      then obtain a b 
        where ab_def: "ab = [a, b]∘" 
          and a: "a ∈∘ 𝔄⦇Obj⦈" 
          and b: "b ∈∘ 𝔅⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF assms(1,2)])
      from assms a b have ba: "[b, a]∘ ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
        by (cs_concl cs_intro: cat_prod_cs_intros)
      from assms bifunctor_flip_ObjMap_vsv prems a b ba show 
        "𝔉⦇ObjMapβ¦ˆβ¦‡ab⦈ ∈∘ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈)"
        by (cs_concl cs_simp: ab_def cat_cs_simps cs_intro: V_cs_intros)
    qed auto

  qed

qed


subsubsectionβ€ΉBifunctor flip arrow mapβ€Ί

lemma bifunctor_flip_ArrMap_vsv[cat_cs_intros]: 
  "vsv (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈)"
  unfolding bifunctor_flip_components by (rule fflip_vsv)

lemma bifunctor_flip_ArrMap_app:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "g ∈∘ 𝔄⦇Arr⦈"
    and "f ∈∘ 𝔅⦇Arr⦈"
  shows "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f, gβ¦ˆβˆ™ = 𝔉⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™"
  using assms
  unfolding bifunctor_flip_components
  by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)

lemma bifunctor_flip_ArrMap_app'[cat_cs_simps]:
  assumes "fg = [f, g]∘"
    and "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "g ∈∘ 𝔄⦇Arr⦈"
    and "f ∈∘ 𝔅⦇Arr⦈"
  shows "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡fg⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™"
  using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ArrMap_app)

lemma bifunctor_flip_ArrMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈) = (𝔅 Γ—C 𝔄)⦇Arr⦈"
  using assms
  unfolding bifunctor_flip_components 
  by (cs_concl cs_simp: V_cs_simps cat_cs_simps)

lemma bifunctor_flip_ArrMap_vrange[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈) = β„›βˆ˜ (𝔉⦇ArrMap⦈)"
proof-
  
  interpret 𝔉: is_functor Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔉 by (rule assms(3))

  show ?thesis
  proof(intro vsubset_antisym)

    show "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈) βŠ†βˆ˜ β„›βˆ˜ (𝔉⦇ArrMap⦈)"
    proof
      (
        intro vsv.vsv_vrange_vsubset, 
        unfold bifunctor_flip_ArrMap_vdomain[OF assms]
      )
      fix fg assume "fg ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈"
      then obtain f g
        where fg_def: "fg = [f, g]∘" 
          and f: "f ∈∘ 𝔅⦇Arr⦈" 
          and g: "g ∈∘ 𝔄⦇Arr⦈"
        by (elim cat_prod_2_ArrE[OF assms(2,1)])
      from f obtain a b where f: "f : a ↦𝔅 b" by (auto intro: is_arrI)
      from g obtain a' b' where g: "g : a' ↦𝔄 b'" by (auto intro: is_arrI)
      from 𝔉.cf_ArrMap_vsv assms f g show 
        "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡fg⦈ ∈∘ β„›βˆ˜ (𝔉⦇ArrMap⦈)"
        unfolding fg_def
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: V_cs_intros cat_cs_intros cat_prod_cs_intros
          )
    qed (auto intro: cat_cs_intros)

    show "β„›βˆ˜ (𝔉⦇ArrMap⦈) βŠ†βˆ˜ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈)"
    proof(intro vsv.vsv_vrange_vsubset, unfold 𝔉.cf_ArrMap_vdomain)
      fix gf assume prems: "gf ∈∘ (𝔄 Γ—C 𝔅)⦇Arr⦈"
      then obtain g f 
        where gf_def: "gf = [g, f]∘" 
          and g: "g ∈∘ 𝔄⦇Arr⦈"
          and f: "f ∈∘ 𝔅⦇Arr⦈"
        by (elim cat_prod_2_ArrE[OF assms(1,2)])
      from assms g f have fg: "[f, g]∘ ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈"
        by (cs_concl cs_intro: cat_prod_cs_intros)
      from assms bifunctor_flip_ArrMap_vsv prems g f fg show 
        "𝔉⦇ArrMapβ¦ˆβ¦‡gf⦈ ∈∘ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈)"
        unfolding gf_def
        by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
    qed auto

  qed

qed


subsubsectionβ€ΉBifunctor flip is a bifunctorβ€Ί

lemma bifunctor_flip_is_functor:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
  shows "bifunctor_flip 𝔄 𝔅 𝔉 : 𝔅 Γ—C 𝔄 ↦↦CΞ± β„­ "
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret 𝔉: is_functor Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔉 by (rule assms)

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (bifunctor_flip 𝔄 𝔅 𝔉)"
      unfolding bifunctor_flip_def by simp
    from assms(1,2) show "category Ξ± (𝔅 Γ—C 𝔄)"
      by (cs_concl cs_intro: cat_cs_intros)
    show "vcard (bifunctor_flip 𝔄 𝔅 𝔉) = 4β„•"
      unfolding bifunctor_flip_def by (simp add: nat_omega_simps)
    show "vsv (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈)" by (auto intro: cat_cs_intros)
    show "vsv (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈)" by (auto intro: cat_cs_intros)
    from assms show "π’Ÿβˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) = (𝔅 Γ—C 𝔄)⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    from assms 𝔉.cf_ObjMap_vrange show 
      "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    from assms show "π’Ÿβˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈) = (𝔅 Γ—C 𝔄)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    show "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡gf⦈ :
      bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡ba⦈ ↦ℭ
      bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'a'⦈"
      if "gf : ba ↦𝔅 Γ—C 𝔄 b'a'" for ba b'a' gf
    proof-
      from that obtain g f a b a' b'
        where gf_def: "gf = [g, f]∘"
          and ba_def: "ba = [b, a]∘"
          and b'a'_def: "b'a' = [b', a']∘"
          and g: "g : b ↦𝔅 b'"
          and f: "f : a ↦𝔄 a'"
        by (elim cat_prod_2_is_arrE[OF assms(2,1)])
      from assms g f show ?thesis
        unfolding gf_def ba_def b'a'_def
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
    show 
      "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡gg' ∘A𝔅 Γ—C 𝔄 ff'⦈ =
        bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡gg'⦈ ∘Aβ„­ 
        bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡ff'⦈"
      if gg': "gg' : bb' ↦𝔅 Γ—C 𝔄 cc'" and ff': "ff' : aa' ↦𝔅 Γ—C 𝔄 bb'" 
      for bb' cc' gg' aa' ff'
    proof-
      obtain g g' b b' c c' 
        where gg'_def: "gg' = [g, g']∘"
          and bb'_def: "bb' = [b, b']∘"
          and cc'_def: "cc' = [c, c']∘"   
          and g: "g : b ↦𝔅 c"  
          and g': "g' : b' ↦𝔄 c'"
        by (elim cat_prod_2_is_arrE[OF assms(2,1) gg'])
      moreover obtain f f' a a' b'' b''' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and "bb' = [b'', b''']∘"   
          and "f : a ↦𝔅 b''"  
          and "f' : a' ↦𝔄 b'''"
        by (elim cat_prod_2_is_arrE[OF assms(2,1) ff'])
      ultimately have f: "f : a ↦𝔅 b" and f': "f' : a' ↦𝔄 b'" 
        by (auto simp: cat_op_simps)
      from assms g g' f f' have [cat_cs_simps]:
        "𝔉⦇ArrMapβ¦ˆβ¦‡g' ∘A𝔄 f', g ∘A𝔅 fβ¦ˆβˆ™ = 
          𝔉⦇ArrMapβ¦ˆβ¦‡[g', g]∘ ∘A𝔄 Γ—C 𝔅 [f', f]∘⦈"
        by (cs_concl cs_simp: cat_prod_2_Comp_app cs_intro: cat_prod_cs_intros)
      from assms g g' f f' show 
        "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡gg' ∘A𝔅 Γ—C 𝔄 ff'⦈ =
          bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡gg'⦈ ∘Aβ„­
          bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡ff'⦈"
        unfolding gg'_def ff'_def (*slow*)
        by 
          (
            cs_concl 
              cs_simp: cat_prod_cs_simps cat_cs_simps
              cs_intro: cat_prod_cs_intros cat_cs_intros
          )
    qed
    show 
      "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡(𝔅 Γ—C 𝔄)⦇CIdβ¦ˆβ¦‡ba⦈⦈ = 
        ℭ⦇CIdβ¦ˆβ¦‡bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡ba⦈⦈"
      if "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈" for ba
    proof-
      from that obtain b a 
        where ba_def: "ba = [b, a]∘" 
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and a: "a ∈∘ 𝔄⦇Obj⦈"
        by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
      from assms b a have [cat_cs_simps]:
        "𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™ =
          𝔉⦇ArrMapβ¦ˆβ¦‡(𝔄 Γ—C 𝔅)⦇CIdβ¦ˆβ¦‡a, bβ¦ˆβˆ™β¦ˆ"
        by (cs_concl cs_simp: cat_prod_2_CId_app cs_intro: cat_prod_cs_intros)
      from assms b a show ?thesis
        unfolding ba_def
        by 
          (
            cs_concl 
              cs_intro: cat_cs_intros cat_prod_cs_intros 
              cs_simp: cat_prod_cs_simps cat_cs_simps
          )
    qed
  qed (auto simp: bifunctor_flip_components cat_cs_simps cat_cs_intros)

qed

lemma bifunctor_flip_is_functor'[cat_cs_intros]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "𝔇 = 𝔅 Γ—C 𝔄"
  shows "bifunctor_flip 𝔄 𝔅 𝔉 : 𝔇 ↦↦CΞ± β„­"
  using assms(1-3) unfolding assms(4) by (intro bifunctor_flip_is_functor)


subsubsectionβ€ΉDouble-flip of a bifunctorβ€Ί

lemma bifunctor_flip_flip[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
  shows "bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉) = 𝔉"
proof(rule cf_eqI)

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret 𝔉: is_functor Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔉 by (rule assms(3))

  from assms show 
    "bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉) : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)

  from assms have ObjMap_dom_lhs: 
    "π’Ÿβˆ˜ (bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉)⦇ObjMap⦈) = 
      (𝔄 Γ—C 𝔅)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  have ObjMap_dom_rhs: "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = (𝔄 Γ—C 𝔅)⦇Obj⦈" 
    by (simp add: cat_cs_simps)
  from assms have ArrMap_dom_lhs: 
    "π’Ÿβˆ˜ (bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉)⦇ArrMap⦈) =
      (𝔄 Γ—C 𝔅)⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  have ArrMap_dom_rhs: "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = (𝔄 Γ—C 𝔅)⦇Arr⦈" 
    by (simp add: cat_cs_simps)

  show "bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉)⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix ab assume "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" and a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈" 
      by (rule cat_prod_2_ObjE[OF assms(1,2)])
    from assms a b show 
      "bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉)⦇ObjMapβ¦ˆβ¦‡ab⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡ab⦈"
      unfolding ab_def
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: cat_cs_intros)

  show "bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉)⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix ab assume "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Arr⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" and a: "a ∈∘ 𝔄⦇Arr⦈" and b: "b ∈∘ 𝔅⦇Arr⦈" 
      by (rule cat_prod_2_ArrE[OF assms(1,2)])
    from assms a b show 
      "bifunctor_flip 𝔅 𝔄 (bifunctor_flip 𝔄 𝔅 𝔉)⦇ArrMapβ¦ˆβ¦‡ab⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡ab⦈"
      unfolding ab_def 
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: cat_cs_intros)

qed (simp_all add: assms(3))


subsubsectionβ€ΉA projection of a bifunctor flipβ€Ί

lemma bifunctor_flip_proj_snd[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF = 𝔉𝔄,𝔅(-,b)CF"
proof(rule cf_eqI)

  from assms show f_𝔉b: "bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  from assms show 𝔉b: "𝔉𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)

  from assms have ObjMap_dom_lhs:
    "π’Ÿβˆ˜ ((bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms have ObjMap_dom_rhs: "π’Ÿβˆ˜ ((𝔉𝔄,𝔅(-,b)CF)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from assms have ArrMap_dom_lhs:
    "π’Ÿβˆ˜ ((bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms have ArrMap_dom_rhs: "π’Ÿβˆ˜ ((𝔉𝔄,𝔅(-,b)CF)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps)

  show "(bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ObjMap⦈ = (𝔉𝔄,𝔅(-,b)CF)⦇ObjMap⦈"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    from assms show "vsv ((bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ObjMap⦈)"
      by (intro bifunctor_proj_snd_ObjMap_vsv)
        (cs_concl cs_intro: cat_cs_intros)
    from assms show "vsv ((𝔉𝔄,𝔅(-,b)CF)⦇ObjMap⦈)"
      by (intro bifunctor_proj_fst_ObjMap_vsv)
        (cs_concl cs_intro: cat_cs_intros)
    fix a assume "a ∈∘ 𝔄⦇Obj⦈"
    with assms show 
      "(bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ObjMapβ¦ˆβ¦‡a⦈ = 
        (𝔉𝔄,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
  qed simp

  show 
    "(bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ArrMap⦈ = (𝔉𝔄,𝔅(-,b)CF)⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    from assms show "vsv ((bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ArrMap⦈)"
      by (intro bifunctor_proj_snd_ArrMap_vsv)
        (cs_concl cs_intro: cat_cs_intros)
    from assms show "vsv ((𝔉𝔄,𝔅(-,b)CF)⦇ArrMap⦈)"
      by (intro bifunctor_proj_fst_ArrMap_vsv)
        (cs_concl cs_intro: cat_cs_intros)
    fix f assume "f ∈∘ 𝔄⦇Arr⦈"
    with assms show 
      "(bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(b,-)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ =
        (𝔉𝔄,𝔅(-,b)CF)⦇ArrMapβ¦ˆβ¦‡f⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed simp

qed simp_all

lemma bifunctor_flip_proj_fst[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "bifunctor_flip 𝔄 𝔅 𝔉𝔅,𝔄(-,a)CF = 𝔉𝔄,𝔅(a,-)CF"
proof-
  from assms have f_𝔉: "bifunctor_flip 𝔄 𝔅 𝔉 : 𝔅 Γ—C 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  show ?thesis
    by 
      (
        rule 
          bifunctor_flip_proj_snd
            [
              OF assms(2,1) f_𝔉 assms(4), 
              unfolded bifunctor_flip_flip[OF assms(1,2,3)],
              symmetric
            ]
      )
qed


subsubsectionβ€ΉA flip of a bifunctor isomorphismβ€Ί

lemma bifunctor_flip_is_iso_functor:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔉 : 𝔄 Γ—C 𝔅 ↦↦C.isoΞ± β„­"
  shows "bifunctor_flip 𝔄 𝔅 𝔉 : 𝔅 Γ—C 𝔄 ↦↦C.isoΞ± β„­ "
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret 𝔉: is_iso_functor Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔉 by (rule assms(3))

  from assms have f_𝔉: "bifunctor_flip 𝔄 𝔅 𝔉 : 𝔅 Γ—C 𝔄 ↦↦CΞ± β„­ "
    by (cs_concl cs_intro: cat_cs_intros)

  from f_𝔉 have ObjMap_dom: 
    "π’Ÿβˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) = (𝔅 Γ—C 𝔄)⦇Obj⦈" 
    by (cs_concl cs_simp: cat_cs_simps)
  from f_𝔉 have ArrMap_dom: 
    "π’Ÿβˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈) = (𝔅 Γ—C 𝔄)⦇Arr⦈" 
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(intro is_iso_functorI' vsv.vsv_valeq_v11I, unfold ObjMap_dom ArrMap_dom)
    from assms show "bifunctor_flip 𝔄 𝔅 𝔉 : 𝔅 Γ—C 𝔄 ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    fix ba b'a'
    assume prems: 
      "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
      "b'a' ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
      "bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡ba⦈ = bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'a'⦈"
    from prems(1) obtain b a
      where ba_def: "ba = [b, a]∘" 
        and b: "b ∈∘ 𝔅⦇Obj⦈" 
        and a: "a ∈∘ 𝔄⦇Obj⦈" 
      by (elim cat_prod_2_ObjE[OF assms(2,1)])
    from prems(2) obtain a' b'
      where b'a'_def: "b'a' = [b', a']∘" 
        and b': "b' ∈∘ 𝔅⦇Obj⦈" 
        and a': "a' ∈∘ 𝔄⦇Obj⦈" 
      by (rule cat_prod_2_ObjE[OF assms(2,1)])
    from prems(3) assms a b b' a' have 𝔉ab_𝔉a'b': 
      "𝔉⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = 𝔉⦇ObjMapβ¦ˆβ¦‡a', b'β¦ˆβˆ™"
      unfolding ba_def b'a'_def
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
    from assms a b a' b' have "[a, b]∘ = [a', b']∘"
      by 
        (
          cs_concl 
            cs_intro: 
              𝔉.ObjMap.v11_eq_iff[THEN iffD1, OF _ _ 𝔉ab_𝔉a'b'] 
              cat_prod_cs_intros
        )
    then show "ba = b'a'" unfolding ba_def b'a'_def by simp
  next
    fix fg f'g' assume prems:
      "fg ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈"
      "f'g' ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈" 
      "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡fg⦈ = bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f'g'⦈"
    from prems(1) obtain f g
      where fg_def: "fg = [f, g]∘" 
        and f: "f ∈∘ 𝔅⦇Arr⦈" 
        and g: "g ∈∘ 𝔄⦇Arr⦈" 
      by (elim cat_prod_2_ArrE[OF assms(2,1)])
    from prems(2) obtain f' g'
      where f'g'_def: "f'g' = [f', g']∘" 
        and f': "f' ∈∘ 𝔅⦇Arr⦈" 
        and g': "g' ∈∘ 𝔄⦇Arr⦈" 
      by (rule cat_prod_2_ArrE[OF assms(2,1)])
    from prems(3) assms f g f' g' have 𝔉gf_𝔉g'f': 
      "𝔉⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ = 𝔉⦇ArrMapβ¦ˆβ¦‡g', f'β¦ˆβˆ™"
      unfolding fg_def f'g'_def
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
    from assms g f g' f' have "[g, f]∘ = [g', f']∘"
      by 
        (
          cs_concl 
            cs_simp: 
            cs_intro:
              𝔉.ArrMap.v11_eq_iff[THEN iffD1, OF _ _ 𝔉gf_𝔉g'f'] 
              cat_prod_cs_intros
        )
    then show "fg = f'g'" unfolding fg_def f'g'_def by simp
  next
    
    show "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) = ℭ⦇Obj⦈"
    proof(rule vsubset_antisym)
      show "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
      proof(rule vsv.vsv_vrange_vsubset, unfold ObjMap_dom)
        fix ba assume "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
        then obtain b a
          where ba_def: "ba = [b, a]∘" 
            and b: "b ∈∘ 𝔅⦇Obj⦈" 
            and a: "a ∈∘ 𝔄⦇Obj⦈" 
          by (elim cat_prod_2_ObjE[OF assms(2,1)])
        from assms b a show "bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡ba⦈ ∈∘ ℭ⦇Obj⦈"
          unfolding ba_def 
          by (cs_concl cs_intro: cat_cs_intros cf_cs_intros cat_prod_cs_intros)
      qed (auto simp: cat_cs_intros)
      show "ℭ⦇Obj⦈ βŠ†βˆ˜ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈)"
      proof(intro vsubsetI)
        fix c assume prems: "c ∈∘ ℭ⦇Obj⦈"
        from prems obtain ab 
          where ab: "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈" and 𝔉ab: "𝔉⦇ObjMapβ¦ˆβ¦‡ab⦈ = c"
          by blast
        from ab obtain b a
          where ab_def: "ab = [a, b]∘" 
            and a: "a ∈∘ 𝔄⦇Obj⦈" 
            and b: "b ∈∘ 𝔅⦇Obj⦈" 
          by (elim cat_prod_2_ObjE[OF assms(1,2)])
        show "c ∈∘ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMap⦈)"
        proof(intro vsv.vsv_vimageI2', unfold ObjMap_dom)
          from assms a b show "[b, a]∘ ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
            by (cs_concl cs_intro: cat_prod_cs_intros)
          from assms b a prems show "c = bifunctor_flip 𝔄 𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b, aβ¦ˆβˆ™"
            by 
              (
                cs_concl 
                  cs_simp: 𝔉ab[unfolded ab_def] cat_cs_simps
                  cs_intro: cf_cs_intros
              )
        qed (auto intro: cat_cs_intros)
      qed
    qed

    show "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈) = ℭ⦇Arr⦈"
    proof(rule vsubset_antisym)
      show "β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
      proof(rule vsv.vsv_vrange_vsubset, unfold ArrMap_dom)
        show "vsv (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈)" by (auto intro: cat_cs_intros)
        fix fg assume "fg ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈"
        then obtain f g
          where fg_def: "fg = [f, g]∘" 
            and f: "f ∈∘ 𝔅⦇Arr⦈" 
            and g: "g ∈∘ 𝔄⦇Arr⦈" 
          by (elim cat_prod_2_ArrE[OF assms(2,1)])
        from g f obtain a b a' b' 
          where f: "f : a ↦𝔅 b" and g: "g : a' ↦𝔄 b'"
          by (auto intro!: is_arrI)
        from assms f g show "bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡fg⦈ ∈∘ ℭ⦇Arr⦈"
          by (cs_concl cs_simp: fg_def cs_intro: cat_cs_intros cat_prod_cs_intros)
      qed
      show "ℭ⦇Arr⦈ βŠ†βˆ˜ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈)"
      proof(intro vsubsetI)
        fix c assume prems: "c ∈∘ ℭ⦇Arr⦈"
        from prems obtain ab 
          where ab: "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Arr⦈" and 𝔉ab: "𝔉⦇ArrMapβ¦ˆβ¦‡ab⦈ = c"
          by blast
        from ab obtain b a
          where ab_def: "ab = [a, b]∘" 
            and a: "a ∈∘ 𝔄⦇Arr⦈" 
            and b: "b ∈∘ 𝔅⦇Arr⦈" 
          by (elim cat_prod_2_ArrE[OF assms(1,2)])
        show "c ∈∘ β„›βˆ˜ (bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMap⦈)"
        proof(intro vsv.vsv_vimageI2', unfold ArrMap_dom)
          from assms a b show "[b, a]∘ ∈∘ (𝔅 Γ—C 𝔄)⦇Arr⦈"
            by (cs_concl cs_intro: cat_prod_cs_intros)
          from assms b a prems show "c = bifunctor_flip 𝔄 𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡b, aβ¦ˆβˆ™"
            by 
              (
                cs_concl 
                  cs_simp: 𝔉ab[unfolded ab_def] cat_cs_simps 
                  cs_intro: cat_cs_intros 
              )
        qed (auto intro: cat_cs_intros)
      qed
    qed

  qed (auto intro: cat_cs_intros)

qed



subsectionβ€ΉArray bifunctorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_array :: "V β‡’ V β‡’ V β‡’ (V β‡’ V) β‡’ (V β‡’ V) β‡’ V"
  where "cf_array 𝔅 β„­ 𝔇 𝔉 π”Š =
    [
      (Ξ»a∈∘(𝔅 Γ—C β„­)⦇Obj⦈. π”Š (vpfst a)⦇ObjMapβ¦ˆβ¦‡vpsnd a⦈),
      (
        Ξ»f∈∘(𝔅 Γ—C β„­)⦇Arr⦈.
          π”Š (𝔅⦇Codβ¦ˆβ¦‡vpfst f⦈)⦇ArrMapβ¦ˆβ¦‡vpsnd f⦈ ∘A𝔇
          𝔉 (ℭ⦇Domβ¦ˆβ¦‡vpsnd f⦈)⦇ArrMapβ¦ˆβ¦‡vpfst f⦈
      ),
      𝔅 Γ—C β„­,
      𝔇
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_array_components:
  shows "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈ =
    (Ξ»a∈∘(𝔅 Γ—C β„­)⦇Obj⦈. π”Š (vpfst a)⦇ObjMapβ¦ˆβ¦‡vpsnd a⦈)"
    and "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMap⦈ =
      (
        Ξ»f∈∘(𝔅 Γ—C β„­)⦇Arr⦈.
          π”Š (𝔅⦇Codβ¦ˆβ¦‡vpfst f⦈)⦇ArrMapβ¦ˆβ¦‡vpsnd f⦈ ∘A𝔇
          𝔉 (ℭ⦇Domβ¦ˆβ¦‡vpsnd f⦈)⦇ArrMapβ¦ˆβ¦‡vpfst f⦈
      )"
    and "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡HomDom⦈ = 𝔅 Γ—C β„­"
    and "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡HomCod⦈ = 𝔇"
  unfolding cf_array_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_array_ObjMap_vsv: "vsv (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈)"
  unfolding cf_array_components by simp

lemma cf_array_ObjMap_vdomain[cat_cs_simps]:
  "π’Ÿβˆ˜ (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈) = (𝔅 Γ—C β„­)⦇Obj⦈"
  unfolding cf_array_components by simp

lemma cf_array_ObjMap_app[cat_cs_simps]:
  assumes "[b, c]∘ ∈∘ (𝔅 Γ—C β„­)⦇Obj⦈"
  shows "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b, cβ¦ˆβˆ™ = π”Š b⦇ObjMapβ¦ˆβ¦‡c⦈"
  using assms unfolding cf_array_components by (simp add: nat_omega_simps)

lemma cf_array_ObjMap_vrange:
  assumes "category Ξ± 𝔅" 
    and "category Ξ± β„­"
    and "β‹€b. b ∈∘ 𝔅⦇Obj⦈ ⟹ π”Š b : β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ObjMap_vdomain)
  show "vsv (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈)" by (rule cf_array_ObjMap_vsv)
  fix x assume prems: "x ∈∘ (𝔅 Γ—C β„­)⦇Obj⦈"
  then obtain b c where x_def: "x = [b, c]∘" 
    and b: "b ∈∘ 𝔅⦇Obj⦈" 
    and c: "c ∈∘ ℭ⦇Obj⦈"
    by (elim cat_prod_2_ObjE[OF assms(1,2)])
  interpret π”Šb: is_functor Ξ± β„­ 𝔇 β€Ήπ”Š bβ€Ί by (rule assms(3)[OF b])
  from prems c show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈ ∈∘ 𝔇⦇Obj⦈"
    unfolding x_def cf_array_components 
    by (auto simp: nat_omega_simps cat_cs_intros)
qed


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_array_ArrMap_vsv: "vsv (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMap⦈)"
  unfolding cf_array_components by simp

lemma cf_array_ArrMap_vdomain[cat_cs_simps]:
  "π’Ÿβˆ˜ (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMap⦈) = (𝔅 Γ—C β„­)⦇Arr⦈"
  unfolding cf_array_components by simp

lemma cf_array_ArrMap_app[cat_cs_simps]:
  assumes "category Ξ± 𝔅"
    and "category Ξ± β„­"
    and "g : a ↦𝔅 b"
    and "f : a' ↦ℭ b'"
  shows "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ = 
    π”Š b⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔇 𝔉 a'⦇ArrMapβ¦ˆβ¦‡g⦈"
proof-
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))
  from cat_prod_2_is_arrI[OF assms] have "[g, f]∘ ∈∘ (𝔅 Γ—C β„­)⦇Arr⦈" by auto
  with assms show ?thesis
    unfolding cf_array_components by (simp add: nat_omega_simps cat_cs_simps)
qed

lemma cf_array_ArrMap_vrange:
  assumes "category Ξ± 𝔅" 
    and "category Ξ± β„­"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ 𝔉 c : 𝔅 ↦↦CΞ± 𝔇"
    and "β‹€b. b ∈∘ 𝔅⦇Obj⦈ ⟹ π”Š b : β„­ ↦↦CΞ± 𝔇"
    and [cat_cs_simps]: 
      "β‹€b c. b ∈∘ 𝔅⦇Obj⦈ ⟹ c ∈∘ ℭ⦇Obj⦈ ⟹ π”Š b⦇ObjMapβ¦ˆβ¦‡c⦈ = 𝔉 c⦇ObjMapβ¦ˆβ¦‡b⦈"
  shows "β„›βˆ˜ (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ArrMap_vdomain)
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))
  interpret 𝔅ℭ: category Ξ± ‹𝔅 Γ—C β„­β€Ί 
    by (simp add: 𝔅.category_axioms β„­.category_axioms category_cat_prod_2)
  fix gf assume prems: "gf ∈∘ (𝔅 Γ—C β„­)⦇Arr⦈"
  then obtain bc b'c' where gf: "gf : bc ↦𝔅 Γ—C β„­ b'c'" by auto
  then obtain g f b c b' c'
    where gf_def: "gf = [g, f]∘" 
      and "bc = [b, c]∘" 
      and "b'c' = [b', c']∘"
      and g: "g : b ↦𝔅 b'" 
      and f: "f : c ↦ℭ c'"
    by (elim cat_prod_2_is_arrE[OF assms(1,2)])
  then have b: "b ∈∘ 𝔅⦇Obj⦈" 
    and b': "b' ∈∘ 𝔅⦇Obj⦈" 
    and c: "c ∈∘ ℭ⦇Obj⦈" 
    and c': "c' ∈∘ ℭ⦇Obj⦈"
    by auto
  interpret π”Šb: is_functor Ξ± β„­ 𝔇 β€Ήπ”Š bβ€Ί by (rule assms(4)[OF b])
  interpret 𝔉c: is_functor Ξ± 𝔅 𝔇 ‹𝔉 cβ€Ί by (rule assms(3)[OF c])
  interpret π”Šb': is_functor Ξ± β„­ 𝔇 β€Ήπ”Š b'β€Ί by (rule assms(4)[OF b'])
  interpret 𝔉c': is_functor Ξ± 𝔅 𝔇 ‹𝔉 c'β€Ί by (rule assms(3)[OF c'])
  from 
    π”Šb.is_functor_axioms 
    𝔉c.is_functor_axioms 
    π”Šb'.is_functor_axioms 
    𝔉c'.is_functor_axioms 
    π”Šb.HomCod.category_axioms 
    g f
  have "π”Š b'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔇 𝔉 c⦇ArrMapβ¦ˆβ¦‡g⦈ ∈∘ 𝔇⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  with g f prems show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gf⦈ ∈∘ 𝔇⦇Arr⦈"
    unfolding gf_def cf_array_components 
    by (simp add: nat_omega_simps cat_cs_simps)
qed (simp add: cf_array_ArrMap_vsv)


subsubsectionβ€ΉArray bifunctor is a bifunctorβ€Ί

lemma cf_array_specification:
  ―‹See Proposition 1 from Chapter II-3 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "category Ξ± 𝔅"
    and "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ 𝔉 c : 𝔅 ↦↦CΞ± 𝔇"
    and "β‹€b. b ∈∘ 𝔅⦇Obj⦈ ⟹ π”Š b : β„­ ↦↦CΞ± 𝔇"
    and "β‹€b c. b ∈∘ 𝔅⦇Obj⦈ ⟹ c ∈∘ ℭ⦇Obj⦈ ⟹ π”Š b⦇ObjMapβ¦ˆβ¦‡c⦈ = 𝔉 c⦇ObjMapβ¦ˆβ¦‡b⦈"
    and 
      "β‹€b c b' c' f g. ⟦ f : b ↦𝔅 b'; g : c ↦ℭ c' ⟧ ⟹
        π”Š b'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇 𝔉 c⦇ArrMapβ¦ˆβ¦‡f⦈ =
          𝔉 c'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔇 π”Š b⦇ArrMapβ¦ˆβ¦‡g⦈"
  shows cf_array_is_functor: "cf_array 𝔅 β„­ 𝔇 𝔉 π”Š : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and cf_array_ObjMap_app_fst: "β‹€b c. ⟦ b ∈∘ 𝔅⦇Obj⦈; c ∈∘ ℭ⦇Obj⦈ ⟧ ⟹
      cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b, cβ¦ˆβˆ™ = 𝔉 c⦇ObjMapβ¦ˆβ¦‡b⦈"
    and cf_array_ObjMap_app_snd: "β‹€b c. ⟦ b ∈∘ 𝔅⦇Obj⦈; c ∈∘ ℭ⦇Obj⦈ ⟧ ⟹
      cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b, cβ¦ˆβˆ™ = π”Š b⦇ObjMapβ¦ˆβ¦‡c⦈"
    and cf_array_ArrMap_app_fst: "β‹€a b f c. ⟦ f : a ↦𝔅 b; c ∈∘ ℭ⦇Obj⦈⟧ ⟹
      cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f, ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™ = 𝔉 c⦇ArrMapβ¦ˆβ¦‡f⦈"
    and cf_array_ArrMap_app_snd: "β‹€a b g c. ⟦ g : a ↦ℭ b; c ∈∘ 𝔅⦇Obj⦈ ⟧ ⟹
      cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”…β¦‡CIdβ¦ˆβ¦‡c⦈, gβ¦ˆβˆ™ = π”Š c⦇ArrMapβ¦ˆβ¦‡g⦈"
proof-

  interpret 𝔅: category Ξ± 𝔅 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(3))

  from assms(4) have [cat_cs_intros]: "𝔉 c : 𝔅' ↦↦CΞ±' 𝔇'" 
    if "c ∈∘ ℭ⦇Obj⦈" "𝔅' = 𝔅" "𝔇' = 𝔇" "Ξ±' = Ξ±" for Ξ±' c 𝔅' 𝔇'
    using that(1) unfolding that(2-4) by (intro assms(4))
  from assms(4) have [cat_cs_intros]: "π”Š c : β„­' ↦↦CΞ±' 𝔇'" 
    if "c ∈∘ 𝔅⦇Obj⦈" "β„­' = β„­" "𝔇' = 𝔇" "Ξ±' = Ξ±" for Ξ±' c β„­' 𝔇'
    using that(1) unfolding that(2-4) by (intro assms(5))

  show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Š : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  proof(intro is_functorI')
    show "vfsequence (cf_array 𝔅 β„­ 𝔇 𝔉 π”Š)" unfolding cf_array_def by auto
    from assms(1,2) show "category Ξ± (𝔅 Γ—C β„­)"
      by (simp add: category_cat_prod_2)
    show "vcard (cf_array 𝔅 β„­ 𝔇 𝔉 π”Š) = 4β„•"
      unfolding cf_array_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
      by (rule cf_array_ObjMap_vrange) (auto simp: assms intro: cat_cs_intros)
    show cf_array_is_arrI: "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡ff'⦈ :
      cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡aa'⦈ ↦𝔇 cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡bb'⦈"
      if ff': "ff' : aa' ↦𝔅 Γ—C β„­ bb'" for aa' bb' ff'
    proof-
      obtain f f' a a' b b' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and bb'_def: "bb' = [b, b']∘"   
          and f: "f : a ↦𝔅 b"  
          and f': "f' : a' ↦ℭ b'"
        by (elim cat_prod_2_is_arrE[OF 𝔅.category_axioms β„­.category_axioms ff'])
      then have a: "a ∈∘ 𝔅⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈" 
        and a': "a' ∈∘ ℭ⦇Obj⦈" 
        and b': "b' ∈∘ ℭ⦇Obj⦈"
        by auto
      from f' assms(5)[OF a] a have
        "π”Š a⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉 a'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉 b'⦇ObjMapβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
      with assms(1-3) f f' assms(4)[OF b'] show ?thesis
        unfolding ff'_def aa'_def bb'_def
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps assms(6) 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
    show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gg' ∘A𝔅 Γ—C β„­ ff'⦈ = 
      cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gg'⦈ ∘A𝔇 cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡ff'⦈"
      if gg': "gg' : bb' ↦𝔅 Γ—C β„­ cc'" and ff': "ff' : aa' ↦𝔅 Γ—C β„­ bb'" 
      for bb' cc' gg' aa' ff'
    proof-
      obtain g g' b b' c c' 
        where gg'_def: "gg' = [g, g']∘"
          and bb'_def: "bb' = [b, b']∘"
          and cc'_def: "cc' = [c, c']∘"   
          and g: "g : b ↦𝔅 c"  
          and g': "g' : b' ↦ℭ c'"
        by (elim cat_prod_2_is_arrE[OF 𝔅.category_axioms β„­.category_axioms gg'])
      moreover obtain f f' a a' b'' b''' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and "bb' = [b'', b''']∘"   
          and f: "f : a ↦𝔅 b''"  
          and f': "f' : a' ↦ℭ b'''"
        by (elim cat_prod_2_is_arrE[OF 𝔅.category_axioms β„­.category_axioms ff'])
      ultimately have f: "f : a ↦𝔅 b" and f': "f' : a' ↦ℭ b'" by auto
      with g have a: "a ∈∘ 𝔅⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈" 
        and c: "c ∈∘ 𝔅⦇Obj⦈" 
        and a': "a' ∈∘ ℭ⦇Obj⦈" 
        and b': "b' ∈∘ ℭ⦇Obj⦈"
        and c': "b' ∈∘ ℭ⦇Obj⦈"
        by auto
      from f' assms(5)[OF a] a have π”Ša_f':
        "π”Š a⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉 a'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉 b'⦇ObjMapβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
      from f' b assms(5)[OF b] have π”Šb_f': 
        "π”Š b⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉 a'⦇ObjMapβ¦ˆβ¦‡b⦈ ↦𝔇 𝔉 b'⦇ObjMapβ¦ˆβ¦‡b⦈"
        by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
      from f' c assms(5)[OF c] have π”Šc_f':
        "π”Š c⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉 a'⦇ObjMapβ¦ˆβ¦‡c⦈ ↦𝔇 𝔉 b'⦇ObjMapβ¦ˆβ¦‡c⦈"
        by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
      have
        "𝔉 b'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇 (𝔉 b'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔇 π”Š a⦇ArrMapβ¦ˆβ¦‡f'⦈) = 
          (π”Š c⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔇 𝔉 a'⦇ArrMapβ¦ˆβ¦‡g⦈) ∘A𝔇 𝔉 a'⦇ArrMapβ¦ˆβ¦‡f⦈"
        using f' f g π”Šb_f' assms(4)[OF a'] assms(4)[OF b'] 
        by (cs_concl cs_simp: cat_cs_simps assms(7) cs_intro: cat_cs_intros)
      also have "… =
        π”Š c⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔇 (𝔉 a'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇 𝔉 a'⦇ArrMapβ¦ˆβ¦‡f⦈)"
        using assms(2) f f' g g' assms(4)[OF a'] assms(5)[OF c]
        by (cs_concl cs_simp: assms(6) cat_cs_simps cs_intro: cat_cs_intros)
      finally have [cat_cs_simps]:
        "𝔉 b'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇 (𝔉 b'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔇 π”Š a⦇ArrMapβ¦ˆβ¦‡f'⦈) =
          π”Š c⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔇 (𝔉 a'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇 𝔉 a'⦇ArrMapβ¦ˆβ¦‡f⦈)"
        by simp
      show ?thesis
        using 
          π”Ša_f' π”Šc_f'
          f f' 
          g g'
          assms(1,2)  
          assms(4)[OF a'] 
          assms(4)[OF c']
          assms(5)[OF c]
        unfolding gg'_def ff'_def aa'_def bb'_def cc'_def (*slow*)
        by 
          (
            cs_concl
              cs_simp: assms(6,7) cat_prod_cs_simps cat_cs_simps 
              cs_intro: cat_prod_cs_intros cat_cs_intros
          )
    qed
    show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡(𝔅 Γ—C β„­)⦇CIdβ¦ˆβ¦‡cc'⦈⦈ = 
      𝔇⦇CIdβ¦ˆβ¦‡cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡cc'⦈⦈"
      if "cc' ∈∘ (𝔅 Γ—C β„­)⦇Obj⦈" for cc'
    proof-
      from that obtain c c' 
        where cc'_def: "cc' = [c, c']∘" 
          and c: "c ∈∘ 𝔅⦇Obj⦈" 
          and c': "c' ∈∘ ℭ⦇Obj⦈"
        by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
      from assms(1,2,3) c c' assms(4)[OF c'] assms(5)[OF c] show ?thesis
        unfolding cc'_def (*very slow*)
        by 
          (
            cs_concl 
              cs_simp: cat_prod_cs_simps cat_cs_simps assms(6) 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
  qed (auto simp: cf_array_components cat_cs_intros)

  show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈ ⦇b, cβ¦ˆβˆ™ = 𝔉 c⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "b ∈∘ 𝔅⦇Obj⦈" and "c ∈∘ ℭ⦇Obj⦈" for b c
    using that assms(1,2,3)
    by (cs_concl cs_simp: cat_cs_simps assms(6) cs_intro: cat_prod_cs_intros)
  show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ObjMap⦈ ⦇b, cβ¦ˆβˆ™ = π”Š b⦇ObjMapβ¦ˆβ¦‡c⦈"
    if "b ∈∘ 𝔅⦇Obj⦈" and "c ∈∘ ℭ⦇Obj⦈" for b c 
    using that assms(1,2,3)
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
  show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMap⦈ ⦇f, ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™ = 𝔉 c⦇ArrMapβ¦ˆβ¦‡f⦈"
    if f: "f : a ↦𝔅 b" and c: "c ∈∘ ℭ⦇Obj⦈" for a b f c
  proof-
    from f have "a ∈∘ 𝔅⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈" by auto
    from assms(5)[OF this(1)] assms(5)[OF this(2)] assms(4)[OF c] show ?thesis
      using assms(1,2,3) f c 
      by (cs_concl cs_simp: cat_cs_simps assms(6) cs_intro: cat_cs_intros)
  qed

  show "cf_array 𝔅 β„­ 𝔇 𝔉 π”Šβ¦‡ArrMap⦈ ⦇𝔅⦇CIdβ¦ˆβ¦‡c⦈, gβ¦ˆβˆ™ = π”Š c⦇ArrMapβ¦ˆβ¦‡g⦈"
    if g: "g : a ↦ℭ b" and c: "c ∈∘ 𝔅⦇Obj⦈" for a b g c
  proof-
    from g have "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈" by auto
    from assms(4)[OF this(1)] assms(4)[OF this(2)] assms(5)[OF c] show ?thesis
      using assms(1,2,3) g c
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps assms(6)[symmetric] cs_intro: cat_cs_intros
        )
  qed

qed



subsectionβ€ΉComposition of a covariant bifunctor and covariant functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary properties.β€Ί

definition cf_bcomp :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_bcomp 𝔖 𝔉 π”Š =
    [
      (
        Ξ»a∈∘(𝔉⦇HomDom⦈ Γ—C π”Šβ¦‡HomDom⦈)⦇Obj⦈.
          𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡vpfst a⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡vpsnd aβ¦ˆβ¦ˆβˆ™
      ),
      (
        Ξ»f∈∘(𝔉⦇HomDom⦈ Γ—C π”Šβ¦‡HomDom⦈)⦇Arr⦈.
          𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡vpfst f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡vpsnd fβ¦ˆβ¦ˆβˆ™
      ),
      𝔉⦇HomDom⦈ Γ—C π”Šβ¦‡HomDom⦈,
      𝔖⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_bcomp_components:
  shows "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈ = 
      (
        Ξ»a∈∘(𝔉⦇HomDom⦈ Γ—C π”Šβ¦‡HomDom⦈)⦇Obj⦈.
          𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡vpfst a⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡vpsnd aβ¦ˆβ¦ˆβˆ™
      )"
    and "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMap⦈ = 
      (
        Ξ»f∈∘(𝔉⦇HomDom⦈ Γ—C π”Šβ¦‡HomDom⦈)⦇Arr⦈.
          𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡vpfst f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡vpsnd fβ¦ˆβ¦ˆβˆ™
      )"
    and "cf_bcomp 𝔖 𝔉 π”Šβ¦‡HomDom⦈ = 𝔉⦇HomDom⦈ Γ—C π”Šβ¦‡HomDom⦈"
    and "cf_bcomp 𝔖 𝔉 π”Šβ¦‡HomCod⦈ = 𝔖⦇HomCod⦈"
  unfolding cf_bcomp_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_bcomp_ObjMap_vsv: "vsv (cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈)"
  unfolding cf_bcomp_components by simp

lemma cf_bcomp_ObjMap_vdomain[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅" and "π”Š : β„­' ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈) = (𝔅' Γ—C β„­')⦇Obj⦈"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms)
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms)
  show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
qed

lemma cf_bcomp_ObjMap_app[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "[a, b]∘ ∈∘ (𝔅' Γ—C β„­')⦇Obj⦈"
  shows "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = 𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  from assms show ?thesis 
    unfolding cf_bcomp_components 
    by (simp_all add: cat_cs_simps nat_omega_simps)
qed

lemma cf_bcomp_ObjMap_vrange:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
proof
  (
    rule vsv.vsv_vrange_vsubset, 
    unfold cf_bcomp_ObjMap_vdomain[OF assms(1,2)]
  )
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  show "vsv (cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈)" by (rule cf_bcomp_ObjMap_vsv)
  fix bc assume "bc ∈∘ (𝔅' Γ—C β„­')⦇Obj⦈"
  with 𝔉.HomDom.category_axioms π”Š.HomDom.category_axioms obtain b c 
    where bc_def: "bc = [b, c]∘" and b: "b ∈∘ 𝔅'⦇Obj⦈" and c: "c ∈∘ β„­'⦇Obj⦈"
    by (elim cat_prod_2_ObjE[rotated -1])  
  from assms b c show "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡bc⦈ ∈∘ 𝔇⦇Obj⦈"
    unfolding bc_def 
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_bcomp_ArrMap_vsv: "vsv (cf_bcomp β„­ 𝔖 𝔉⦇ArrMap⦈)"
  unfolding cf_bcomp_components by simp

lemma cf_bcomp_ArrMap_vdomain[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅" and "π”Š : β„­' ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMap⦈) = (𝔅' Γ—C β„­')⦇Arr⦈"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
qed

lemma cf_bcomp_ArrMap_app[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "[g, f]∘ ∈∘ (𝔅' Γ—C β„­')⦇Arr⦈"
  shows "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ = 𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡g⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦ˆβˆ™"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  from assms show ?thesis 
    unfolding cf_bcomp_components by (simp_all add: nat_omega_simps cat_cs_simps)
qed

lemma cf_bcomp_ArrMap_vrange:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_bcomp_ArrMap_vdomain[OF assms(1,2)])
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  fix gf assume "gf ∈∘ (𝔅' Γ—C β„­')⦇Arr⦈"
  with 𝔉.HomDom.category_axioms π”Š.HomDom.category_axioms obtain g f
    where gf_def: "gf = [g, f]∘" and g: "g ∈∘ 𝔅'⦇Arr⦈" and f: "f ∈∘ β„­'⦇Arr⦈"
    by (elim cat_prod_2_ArrE[rotated -1])  
  from g obtain a b where g: "g : a ↦𝔅' b" by auto
  from f obtain a' b' where f: "f : a' ↦ℭ' b'" by auto
  from assms g f show "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gf⦈ ∈∘ 𝔇⦇Arr⦈"
    unfolding gf_def 
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed (simp add: cf_bcomp_ArrMap_vsv)


subsubsectionβ€Ή
Composition of a covariant bifunctor and 
covariant functors is a functor
β€Ί

lemma cf_bcomp_is_functor:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "cf_bcomp 𝔖 𝔉 π”Š : 𝔅' Γ—C β„­' ↦↦CΞ± 𝔇"
proof-

  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  interpret 𝔖: is_functor Ξ± ‹𝔅 Γ—C β„­β€Ί 𝔇 𝔖 by (rule assms(3))

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (cf_bcomp 𝔖 𝔉 π”Š)" unfolding cf_bcomp_def by simp
    show "category Ξ± (𝔅' Γ—C β„­')"
      by 
        (
          simp add: 
            𝔉.HomDom.category_axioms  
            π”Š.HomDom.category_axioms 
            category_cat_prod_2
        )
    show "vcard (cf_bcomp 𝔖 𝔉 π”Š) = 4β„•"
      unfolding cf_bcomp_def by (simp add: nat_omega_simps)
    from assms show "β„›βˆ˜ (cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
      by (rule cf_bcomp_ObjMap_vrange)
    show "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡ff'⦈ :
      cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡aa'⦈ ↦𝔇 cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡bb'⦈"
    if ff': "ff' : aa' ↦𝔅' Γ—C β„­' bb'" for aa' bb' ff'
    proof-
      obtain f f' a a' b b' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and bb'_def: "bb' = [b, b']∘"   
          and f: "f : a ↦𝔅' b"  
          and f': "f' : a' ↦ℭ' b'"
        by 
          (
            elim 
              cat_prod_2_is_arrE[
                OF 𝔉.HomDom.category_axioms π”Š.HomDom.category_axioms ff'
                ]
          )
      from assms f f' show ?thesis
        unfolding ff'_def aa'_def bb'_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
    show "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gg' ∘A𝔅' Γ—C β„­' ff'⦈ =
      cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gg'⦈ ∘A𝔇 cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡ff'⦈"
      if gg': "gg' : bb' ↦𝔅' Γ—C β„­' cc'" 
        and ff': "ff' : aa' ↦𝔅' Γ—C β„­' bb'"
      for bb' cc' gg' aa' ff'
    proof-
      obtain g g' b b' c c' 
        where gg'_def: "gg' = [g, g']∘"
          and bb'_def: "bb' = [b, b']∘"
          and cc'_def: "cc' = [c, c']∘"   
          and g: "g : b ↦𝔅' c"  
          and g': "g' : b' ↦ℭ' c'"
        by 
          (
            elim cat_prod_2_is_arrE[
              OF 𝔉.HomDom.category_axioms π”Š.HomDom.category_axioms gg'
              ]
          )
      moreover obtain f f' a a' b'' b''' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and "bb' = [b'', b''']∘"   
          and f: "f : a ↦𝔅' b''"  
          and f': "f' : a' ↦ℭ' b'''"
        by 
          (
            elim cat_prod_2_is_arrE[
              OF 𝔉.HomDom.category_axioms π”Š.HomDom.category_axioms ff'
              ]
          )
      ultimately have f: "f : a ↦𝔅' b" and f': "f' : a' ↦ℭ' b'" by auto
      from assms f f' g g' have [cat_cs_simps]:
        "[𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈]∘ = 
          [𝔉⦇ArrMapβ¦ˆβ¦‡g⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈]∘ ∘A𝔅 Γ—C β„­ [𝔉⦇ArrMapβ¦ˆβ¦‡f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈]∘"
        by 
          (
            cs_concl 
              cs_simp: cat_prod_cs_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from assms f f' g g' show ?thesis
        unfolding gg'_def ff'_def aa'_def bb'_def cc'_def
        by
          (
            cs_concl
              cs_simp: cat_prod_cs_simps cat_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
    show 
      "cf_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡(𝔅' Γ—C β„­')⦇CIdβ¦ˆβ¦‡cc'⦈⦈ = 
        𝔇⦇CIdβ¦ˆβ¦‡cf_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡cc'⦈⦈"
      if "cc' ∈∘ (𝔅' Γ—C β„­')⦇Obj⦈" for cc'
    proof-
      from that obtain c c' 
        where cc'_def: "cc' = [c, c']∘" 
          and c: "c ∈∘ 𝔅'⦇Obj⦈"
          and c': "c' ∈∘ β„­'⦇Obj⦈"
        by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
      from assms c c' have [cat_cs_simps]: 
        "[𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈, ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡c'⦈⦈]∘ = 
          (𝔅 Γ—C β„­)⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡c'β¦ˆβ¦ˆβˆ™"
        by
          (
            cs_concl
              cs_simp: cat_prod_cs_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from assms c c' show ?thesis
        unfolding cc'_def
        by
          (
            cs_concl 
              cs_simp: cat_prod_cs_simps cat_cs_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
  qed (auto simp: cf_bcomp_components cat_cs_intros cat_cs_simps)

qed

lemma cf_bcomp_is_functor'[cat_cs_intros]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "𝔄' =  𝔅' Γ—C β„­'"
  shows "cf_bcomp 𝔖 𝔉 π”Š : 𝔄' ↦↦CΞ± 𝔇"
  using assms(1-3) unfolding assms(4) by (rule cf_bcomp_is_functor)



subsectionβ€ΉComposition of a contracovariant bifunctor and covariant functorsβ€Ί

textβ€Ή
The term β€Ήcontracovariant bifunctorβ€Ί is used to refer to a bifunctor
that is contravariant in the first argument and covariant in the second
argument.
β€Ί

definition cf_cn_cov_bcomp :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_cn_cov_bcomp 𝔖 𝔉 π”Š =
    [
      (
        Ξ»a∈∘(op_cat (𝔉⦇HomDom⦈) Γ—C π”Šβ¦‡HomDom⦈)⦇Obj⦈.
          𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡vpfst a⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡vpsnd aβ¦ˆβ¦ˆβˆ™
      ),
      (
        Ξ»f∈∘(op_cat (𝔉⦇HomDom⦈) Γ—C π”Šβ¦‡HomDom⦈)⦇Arr⦈.
          𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡vpfst f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡vpsnd fβ¦ˆβ¦ˆβˆ™
      ),
      op_cat (𝔉⦇HomDom⦈) Γ—C π”Šβ¦‡HomDom⦈,
      𝔖⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_cn_cov_bcomp_components:
  shows "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈ =
      (
        Ξ»a∈∘(op_cat (𝔉⦇HomDom⦈) Γ—C π”Šβ¦‡HomDom⦈)⦇Obj⦈.
          𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡vpfst a⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡vpsnd aβ¦ˆβ¦ˆβˆ™
      )"
    and "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMap⦈ =
      (
        Ξ»f∈∘(op_cat (𝔉⦇HomDom⦈) Γ—C π”Šβ¦‡HomDom⦈)⦇Arr⦈.
          𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡vpfst f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡vpsnd fβ¦ˆβ¦ˆβˆ™
      )"
    and "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡HomDom⦈ = op_cat (𝔉⦇HomDom⦈) Γ—C π”Šβ¦‡HomDom⦈"
    and "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡HomCod⦈ = 𝔖⦇HomCod⦈"
  unfolding cf_cn_cov_bcomp_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_cn_cov_bcomp_ObjMap_vsv: "vsv (cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈)"
  unfolding cf_cn_cov_bcomp_components by simp

lemma cf_cn_cov_bcomp_ObjMap_vdomain[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅" and "π”Š : β„­' ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈) = (op_cat 𝔅' Γ—C β„­')⦇Obj⦈"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  show ?thesis 
    unfolding cf_cn_cov_bcomp_components 
    by (simp add: nat_omega_simps cat_cs_simps)
qed

lemma cf_cn_cov_bcomp_ObjMap_app[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "[a, b]∘ ∈∘ (op_cat 𝔅' Γ—C β„­')⦇Obj⦈"
  shows 
    "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ =
      𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  from assms show ?thesis 
    unfolding cf_cn_cov_bcomp_components 
    by (simp_all add: cat_cs_simps nat_omega_simps)
qed

lemma cf_cn_cov_bcomp_ObjMap_vrange:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
proof
  (
    rule vsv.vsv_vrange_vsubset, 
    unfold cf_cn_cov_bcomp_ObjMap_vdomain[OF assms(1,2)]
  )
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  show "vsv (cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈)" 
    by (rule cf_cn_cov_bcomp_ObjMap_vsv)
  fix bc assume "bc ∈∘ (op_cat 𝔅' Γ—C β„­')⦇Obj⦈"
  with 𝔉.HomDom.category_op π”Š.HomDom.category_axioms obtain b c 
    where bc_def: "bc = [b, c]∘" 
      and b: "b ∈∘ op_cat 𝔅'⦇Obj⦈" 
      and c: "c ∈∘ β„­'⦇Obj⦈"
    by (elim cat_prod_2_ObjE[rotated -1])  
  from assms b c show "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡bc⦈ ∈∘ 𝔇⦇Obj⦈"
    unfolding bc_def cat_op_simps
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
qed


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_cn_cov_bcomp_ArrMap_vsv: "vsv (cf_cn_cov_bcomp β„­ 𝔖 𝔉⦇ArrMap⦈)"
  unfolding cf_cn_cov_bcomp_components by simp

lemma cf_cn_cov_bcomp_ArrMap_vdomain[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅" and "π”Š : β„­' ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMap⦈) = (op_cat 𝔅' Γ—C β„­')⦇Arr⦈"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  show ?thesis unfolding cf_cn_cov_bcomp_components by (simp add: cat_cs_simps)
qed

lemma cf_cn_cov_bcomp_ArrMap_app[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "[g, f]∘ ∈∘ (op_cat 𝔅' Γ—C β„­')⦇Arr⦈"
  shows "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ =
    𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡g⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦ˆβˆ™"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  from assms show ?thesis 
    unfolding cf_cn_cov_bcomp_components 
    by (simp_all add: nat_omega_simps cat_cs_simps)
qed

lemma cf_cn_cov_bcomp_ArrMap_vrange:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_cn_cov_bcomp_ArrMap_vdomain[OF assms(1,2)])
  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  fix gf assume "gf ∈∘ (op_cat 𝔅' Γ—C β„­')⦇Arr⦈"
  with 𝔉.HomDom.category_op π”Š.HomDom.category_axioms obtain g f
    where gf_def: "gf = [g, f]∘" 
      and g: "g ∈∘ op_cat 𝔅'⦇Arr⦈" 
      and f: "f ∈∘ β„­'⦇Arr⦈"
    by (elim cat_prod_2_ArrE[rotated -1])  
  from g obtain a b where g: "g : a ↦𝔅' b" unfolding cat_op_simps by auto
  from f obtain a' b' where f: "f : a' ↦ℭ' b'" by auto
  from assms g f show "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gf⦈ ∈∘ 𝔇⦇Arr⦈"
    unfolding gf_def 
    by
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
qed (rule cf_cn_cov_bcomp_ArrMap_vsv)


subsubsectionβ€Ή
Composition of a contracovariant bifunctor and functors is a functor
β€Ί

lemma cf_cn_cov_bcomp_is_functor:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "cf_cn_cov_bcomp 𝔖 𝔉 π”Š : op_cat 𝔅' Γ—C β„­' ↦↦CΞ± 𝔇"
proof-

  interpret 𝔉: is_functor Ξ± 𝔅' 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­' β„­ π”Š by (rule assms(2))
  interpret 𝔖: is_functor Ξ± β€Ήop_cat 𝔅 Γ—C β„­β€Ί 𝔇 𝔖 by (rule assms(3))

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (cf_cn_cov_bcomp 𝔖 𝔉 π”Š)" 
      unfolding cf_cn_cov_bcomp_def by simp
    show "category Ξ± (op_cat 𝔅' Γ—C β„­')"
      by 
        (
          simp add: 
            𝔉.HomDom.category_op π”Š.HomDom.category_axioms category_cat_prod_2
        )
    show "vcard (cf_cn_cov_bcomp 𝔖 𝔉 π”Š) = 4β„•"
      unfolding cf_cn_cov_bcomp_def by (simp add: nat_omega_simps)
    from assms show "β„›βˆ˜ (cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
      by (rule cf_cn_cov_bcomp_ObjMap_vrange)
    show 
      "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡ff'⦈ :
        cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡aa'⦈ ↦𝔇
        cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡bb'⦈"
      if ff': "ff' : aa' ↦op_cat 𝔅' Γ—C β„­' bb'" for aa' bb' ff'
    proof-
      obtain f f' a a' b b' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and bb'_def: "bb' = [b, b']∘"   
          and f: "f : a ↦op_cat 𝔅' b"  
          and f': "f' : a' ↦ℭ' b'"
        by 
          (
            elim 
              cat_prod_2_is_arrE[
                OF 𝔉.HomDom.category_op π”Š.HomDom.category_axioms ff'
                ]
          )
      from assms f f' show ?thesis
        unfolding ff'_def aa'_def bb'_def cat_op_simps
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed
    show 
      "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gg' ∘Aop_cat 𝔅' Γ—C β„­' ff'⦈ =
        cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡gg'⦈ ∘A𝔇 
        cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡ff'⦈"
      if gg': "gg' : bb' ↦op_cat 𝔅' Γ—C β„­' cc'" 
        and ff': "ff' : aa' ↦op_cat 𝔅' Γ—C β„­' bb'"
      for bb' cc' gg' aa' ff'
    proof-
      obtain g g' b b' c c' 
        where gg'_def: "gg' = [g, g']∘"
          and bb'_def: "bb' = [b, b']∘"
          and cc'_def: "cc' = [c, c']∘"   
          and g: "g : b ↦op_cat 𝔅' c"  
          and g': "g' : b' ↦ℭ' c'"
        by 
          (
            elim cat_prod_2_is_arrE[
              OF 𝔉.HomDom.category_op π”Š.HomDom.category_axioms gg'
              ]
          )
      moreover obtain f f' a a' b'' b''' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and "bb' = [b'', b''']∘"   
          and f: "f : a ↦op_cat 𝔅' b''"  
          and "f' : a' ↦ℭ' b'''"
        by 
          (
            elim cat_prod_2_is_arrE[
              OF 𝔉.HomDom.category_op π”Š.HomDom.category_axioms ff'
              ]
          )
      ultimately have f: "f : a ↦op_cat 𝔅' b" and f': "f' : a' ↦ℭ' b'" 
        by auto
      from assms f f' g g' have [cat_cs_simps]:
        "[
          𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈, 
          π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈
         ]∘ = 
          [𝔉⦇ArrMapβ¦ˆβ¦‡g⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈]∘ ∘Aop_cat 𝔅 Γ—C β„­ 
          [𝔉⦇ArrMapβ¦ˆβ¦‡f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈]∘"
        unfolding cat_op_simps
        by 
          (
            cs_concl 
              cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from assms f f' g g' show ?thesis
        unfolding gg'_def ff'_def aa'_def bb'_def cc'_def cat_op_simps
        by
          (
            cs_concl
              cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed
    show 
      "cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ArrMapβ¦ˆβ¦‡(op_cat 𝔅' Γ—C β„­')⦇CIdβ¦ˆβ¦‡cc'⦈⦈ = 
        𝔇⦇CIdβ¦ˆβ¦‡cf_cn_cov_bcomp 𝔖 𝔉 π”Šβ¦‡ObjMapβ¦ˆβ¦‡cc'⦈⦈"
      if "cc' ∈∘ (op_cat 𝔅' Γ—C β„­')⦇Obj⦈" for cc'
    proof-
      from that obtain c c' 
        where cc'_def: "cc' = [c, c']∘" 
          and c: "c ∈∘ op_cat 𝔅'⦇Obj⦈"
          and c': "c' ∈∘ β„­'⦇Obj⦈"
        by (elim cat_prod_2_ObjE[rotated 2]) 
          (auto intro: cat_cs_intros)
      from assms c c' have [cat_cs_simps]: 
        "[𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈, ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡c'⦈⦈]∘ =
          (op_cat 𝔅 Γ—C β„­)⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡c'β¦ˆβ¦ˆβˆ™"
        unfolding cat_op_simps
        by 
          (
            cs_concl
              cs_simp: cat_prod_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from assms c c' show ?thesis
        unfolding cc'_def cat_op_simps
        by (*slow*)
          (
            cs_concl 
              cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed
  qed (auto simp: cf_cn_cov_bcomp_components cat_cs_simps intro: cat_cs_intros)

qed

lemma cf_cn_cov_bcomp_is_functor'[cat_cs_intros]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅"
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "𝔄' = op_cat 𝔅' Γ—C β„­'"
  shows "cf_cn_cov_bcomp 𝔖 𝔉 π”Š : 𝔄' ↦↦CΞ± 𝔇"
  using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_bcomp_is_functor)


subsubsectionβ€ΉProjection of a contracovariant bifunctor and functorsβ€Ί

lemma cf_cn_cov_bcomp_bifunctor_proj_snd[cat_cs_simps]:
  assumes "𝔉 : 𝔅' ↦↦CΞ± 𝔅" 
    and "π”Š : β„­' ↦↦CΞ± β„­"
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "b ∈∘ 𝔅'⦇Obj⦈"
  shows
    "cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF =
      (𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š"
proof(rule cf_eqI)
  from assms show [intro]: 
    "cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF : β„­' ↦↦CΞ± 𝔇"
    "(𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š : β„­' ↦↦CΞ± 𝔇"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
  from assms have ObjMap_dom_lhs:
    "π’Ÿβˆ˜ ((cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF)⦇ObjMap⦈) = β„­'⦇Obj⦈"
    and ObjMap_dom_rhs:
    "π’Ÿβˆ˜ (((𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š)⦇ObjMap⦈) = β„­'⦇Obj⦈"
    and ArrMap_dom_lhs:
    "π’Ÿβˆ˜ ((cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF)⦇ArrMap⦈) = β„­'⦇Arr⦈"
    and ArrMap_dom_rhs:
    "π’Ÿβˆ˜ (((𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š)⦇ArrMap⦈) = β„­'⦇Arr⦈"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros cs_simp: cat_cs_simps)+
  show 
    "(cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF)⦇ObjMap⦈ =
      ((𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š)⦇ObjMap⦈"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix a assume "a ∈∘ β„­'⦇Obj⦈"
    with assms show 
      "(cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF)⦇ObjMapβ¦ˆβ¦‡a⦈ =
        ((𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š)⦇ObjMapβ¦ˆβ¦‡a⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_prod_cs_simps cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (auto intro: is_functor.cf_ObjMap_vsv) 
  show 
    "(cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF)⦇ArrMap⦈ =
      ((𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š)⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix f assume "f ∈∘ β„­'⦇Arr⦈"
    then obtain a' b' where "f : a' ↦ℭ' b'" by (auto intro: is_arrI)
    with assms show 
      "(cf_cn_cov_bcomp 𝔖 𝔉 π”Šop_cat 𝔅',β„­'(b,-)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ =
        ((𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF) ∘CF π”Š)⦇ArrMapβ¦ˆβ¦‡f⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (auto intro: is_functor.cf_ArrMap_vsv) 
qed simp_all



subsectionβ€ΉComposition of a covariant bifunctor and a covariant functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_lcomp :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_lcomp β„­ 𝔖 𝔉 = cf_bcomp 𝔖 𝔉 (cf_id β„­)"

definition cf_rcomp :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_rcomp 𝔅 𝔖 π”Š = cf_bcomp 𝔖 (cf_id 𝔅) π”Š"


textβ€ΉComponents.β€Ί

lemma cf_lcomp_components:
  shows "cf_lcomp β„­ 𝔖 𝔉⦇HomDom⦈ = 𝔉⦇HomDom⦈ Γ—C β„­"
    and "cf_lcomp β„­ 𝔖 𝔉⦇HomCod⦈ = 𝔖⦇HomCod⦈"
  unfolding cf_lcomp_def cf_bcomp_components dghm_id_components by simp_all

lemma cf_rcomp_components:
  shows "cf_rcomp 𝔅 𝔖 π”Šβ¦‡HomDom⦈ = 𝔅 Γ—C π”Šβ¦‡HomDom⦈"
    and "cf_rcomp 𝔅 𝔖 π”Šβ¦‡HomCod⦈ = 𝔖⦇HomCod⦈"
  unfolding cf_rcomp_def cf_bcomp_components dghm_id_components by simp_all


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_lcomp_ObjMap_vsv: "vsv (cf_lcomp β„­ 𝔖 𝔉⦇ObjMap⦈)"
  unfolding cf_lcomp_def by (rule cf_bcomp_ObjMap_vsv)

lemma cf_rcomp_ObjMap_vsv: "vsv (cf_rcomp β„­ 𝔖 𝔉⦇ObjMap⦈)"
  unfolding cf_rcomp_def by (rule cf_bcomp_ObjMap_vsv)

lemma cf_lcomp_ObjMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ (cf_lcomp β„­ 𝔖 𝔉⦇ObjMap⦈) = (𝔄 Γ—C β„­)⦇Obj⦈"
  using assms 
  unfolding cf_lcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_rcomp_ObjMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± 𝔅" and "π”Š : 𝔄 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_rcomp 𝔅 𝔖 π”Šβ¦‡ObjMap⦈) = (𝔅 Γ—C 𝔄)⦇Obj⦈"
  using assms 
  unfolding cf_rcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_lcomp_ObjMap_app[cat_cs_simps]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "cf_lcomp β„­ 𝔖 𝔉⦇ObjMapβ¦ˆβ¦‡a, cβ¦ˆβˆ™ = 𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈, cβ¦ˆβˆ™"
  using assms 
  unfolding cf_lcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

lemma cf_rcomp_ObjMap_app[cat_cs_simps]:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "b ∈∘ 𝔅⦇Obj⦈" 
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "cf_rcomp 𝔅 𝔖 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b, aβ¦ˆβˆ™ = 𝔖⦇ObjMapβ¦ˆβ¦‡b, π”Šβ¦‡ObjMapβ¦ˆβ¦‡aβ¦ˆβ¦ˆβˆ™"
  using assms 
  unfolding cf_rcomp_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

lemma cf_lcomp_ObjMap_vrange:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_lcomp β„­ 𝔖 𝔉⦇ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
  using assms
  unfolding cf_lcomp_def 
  by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+

lemma cf_rcomp_ObjMap_vrange:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_rcomp 𝔅 𝔖 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
  using assms
  unfolding cf_rcomp_def 
  by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_lcomp_ArrMap_vsv: "vsv (cf_lcomp β„­ 𝔖 𝔉⦇ArrMap⦈)"
  unfolding cf_lcomp_def by (rule cf_bcomp_ArrMap_vsv)

lemma cf_rcomp_ArrMap_vsv: "vsv (cf_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMap⦈)"
  unfolding cf_rcomp_def by (rule cf_bcomp_ArrMap_vsv)

lemma cf_lcomp_ArrMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ (cf_lcomp β„­ 𝔖 𝔉⦇ArrMap⦈) = (𝔄 Γ—C β„­)⦇Arr⦈"
  using assms 
  unfolding cf_lcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_rcomp_ArrMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± 𝔅" and "π”Š : 𝔄 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMap⦈) = (𝔅 Γ—C 𝔄)⦇Arr⦈"
  using assms 
  unfolding cf_rcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_lcomp_ArrMap_app[cat_cs_simps]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "f ∈∘ 𝔄⦇Arr⦈" 
    and "g ∈∘ ℭ⦇Arr⦈"
  shows "cf_lcomp β„­ 𝔖 𝔉⦇ArrMapβ¦ˆβ¦‡f, gβ¦ˆβˆ™ = 𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡f⦈, gβ¦ˆβˆ™"
  using assms 
  unfolding cf_lcomp_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

lemma cf_rcomp_ArrMap_app[cat_cs_simps]:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "f ∈∘ 𝔅⦇Arr⦈" 
    and "g ∈∘ 𝔄⦇Arr⦈"
  shows "cf_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f, gβ¦ˆβˆ™ = 𝔖⦇ArrMapβ¦ˆβ¦‡f, π”Šβ¦‡ArrMapβ¦ˆβ¦‡gβ¦ˆβ¦ˆβˆ™"
  using assms 
  unfolding cf_rcomp_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

lemma cf_lcomp_ArrMap_vrange:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_lcomp β„­ 𝔖 𝔉⦇ArrMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
  using assms
  unfolding cf_lcomp_def
  by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+

lemma cf_rcomp_ArrMap_vrange:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
  using assms
  unfolding cf_rcomp_def
  by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+


subsubsectionβ€Ή
Composition of a covariant bifunctor and a covariant functor is a functor
β€Ί

lemma cf_lcomp_is_functor:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "cf_lcomp β„­ 𝔖 𝔉 : 𝔄 Γ—C β„­ ↦↦CΞ± 𝔇"
  using assms
  unfolding cf_lcomp_def
  by (cs_concl cs_intro: cat_cs_intros)+

lemma cf_lcomp_is_functor'[cat_cs_intros]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "𝔄' = 𝔄 Γ—C β„­"
  shows "cf_lcomp β„­ 𝔖 𝔉 : 𝔄' ↦↦CΞ± 𝔇"
  using assms(1-3) unfolding assms(4) by (rule cf_lcomp_is_functor)

lemma cf_rcomp_is_functor:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "cf_rcomp 𝔅 𝔖 π”Š : 𝔅 Γ—C 𝔄 ↦↦CΞ± 𝔇"
  using assms 
  unfolding cf_rcomp_def 
  by (cs_concl cs_intro: cat_cs_intros)+

lemma cf_rcomp_is_functor'[cat_cs_intros]:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "𝔄' = 𝔅 Γ—C 𝔄"
  shows "cf_rcomp 𝔅 𝔖 π”Š : 𝔄' ↦↦CΞ± 𝔇"
  using assms(1-3) unfolding assms(4) by (rule cf_rcomp_is_functor)



subsectionβ€ΉComposition of a contracovariant bifunctor and a covariant functorβ€Ί

definition cf_cn_cov_lcomp :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_cn_cov_lcomp β„­ 𝔖 𝔉 = cf_cn_cov_bcomp 𝔖 𝔉 (cf_id β„­)"

definition cf_cn_cov_rcomp :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_cn_cov_rcomp 𝔅 𝔖 π”Š = cf_cn_cov_bcomp 𝔖 (cf_id 𝔅) π”Š"


textβ€ΉComponents.β€Ί

lemma cf_cn_cov_lcomp_components:
  shows "cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇HomDom⦈ = op_cat (𝔉⦇HomDom⦈) Γ—C β„­"
    and "cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇HomCod⦈ = 𝔖⦇HomCod⦈"
  unfolding cf_cn_cov_lcomp_def cf_cn_cov_bcomp_components dghm_id_components 
  by simp_all

lemma cf_cn_cov_rcomp_components:
  shows "cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡HomDom⦈ = op_cat 𝔅 Γ—C π”Šβ¦‡HomDom⦈"
    and "cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡HomCod⦈ = 𝔖⦇HomCod⦈"
  unfolding cf_cn_cov_rcomp_def cf_cn_cov_bcomp_components dghm_id_components 
  by simp_all


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_cn_cov_lcomp_ObjMap_vsv: "vsv (cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ObjMap⦈)"
  unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)

lemma cf_cn_cov_rcomp_ObjMap_vsv: "vsv (cf_cn_cov_rcomp β„­ 𝔖 𝔉⦇ObjMap⦈)"
  unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)

lemma cf_cn_cov_lcomp_ObjMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ (cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ObjMap⦈) = (op_cat 𝔄 Γ—C β„­)⦇Obj⦈"
  using assms 
  unfolding cf_cn_cov_lcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_cn_cov_rcomp_ObjMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± 𝔅" and "π”Š : 𝔄 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡ObjMap⦈) = (op_cat 𝔅 Γ—C 𝔄)⦇Obj⦈"
  using assms 
  unfolding cf_cn_cov_rcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_cn_cov_lcomp_ObjMap_app[cat_cs_simps]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "a ∈∘ op_cat 𝔄⦇Obj⦈" 
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ObjMapβ¦ˆβ¦‡a, cβ¦ˆβˆ™ = 𝔖⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈, cβ¦ˆβˆ™"
  using assms 
  unfolding cf_cn_cov_lcomp_def cat_op_simps
  by
    (
      cs_concl
        cs_simp: cat_cs_simps cat_op_simps 
        cs_intro: cat_cs_intros cat_prod_cs_intros
    )

lemma cf_cn_cov_rcomp_ObjMap_app[cat_cs_simps]:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "b ∈∘ op_cat 𝔅⦇Obj⦈" 
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡ObjMapβ¦ˆβ¦‡b, aβ¦ˆβˆ™ = 𝔖⦇ObjMapβ¦ˆβ¦‡b, π”Šβ¦‡ObjMapβ¦ˆβ¦‡aβ¦ˆβ¦ˆβˆ™"
  using assms 
  unfolding cf_cn_cov_rcomp_def cat_op_simps
  by
    (
      cs_concl
        cs_simp: cat_cs_simps cat_op_simps 
        cs_intro: cat_cs_intros cat_prod_cs_intros
    )

lemma cf_cn_cov_lcomp_ObjMap_vrange:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
  using assms
  unfolding cf_cn_cov_lcomp_def 
  by (intro cf_cn_cov_bcomp_ObjMap_vrange) 
    (cs_concl cs_intro: cat_cs_intros)+

lemma cf_cn_cov_rcomp_ObjMap_vrange:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
  using assms
  unfolding cf_cn_cov_rcomp_def 
  by (intro cf_cn_cov_bcomp_ObjMap_vrange) 
    (cs_concl cs_intro: cat_cs_intros)+


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_cn_cov_lcomp_ArrMap_vsv: "vsv (cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ArrMap⦈)"
  unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)

lemma cf_cn_cov_rcomp_ArrMap_vsv: "vsv (cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMap⦈)"
  unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)

lemma cf_cn_cov_lcomp_ArrMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "π’Ÿβˆ˜ (cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ArrMap⦈) = (op_cat 𝔄 Γ—C β„­)⦇Arr⦈"
  using assms 
  unfolding cf_cn_cov_lcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_cn_cov_rcomp_ArrMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± 𝔅" and "π”Š : 𝔄 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMap⦈) = (op_cat 𝔅 Γ—C 𝔄)⦇Arr⦈"
  using assms 
  unfolding cf_cn_cov_rcomp_def 
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_cn_cov_lcomp_ArrMap_app[cat_cs_simps]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    and "f ∈∘ op_cat 𝔄⦇Arr⦈" 
    and "g ∈∘ ℭ⦇Arr⦈"
  shows "cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ArrMapβ¦ˆβ¦‡f, gβ¦ˆβˆ™ = 𝔖⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡f⦈, gβ¦ˆβˆ™"
  using assms 
  unfolding cf_cn_cov_lcomp_def cat_op_simps
  by 
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_op_simps 
        cs_intro: cat_cs_intros cat_prod_cs_intros
    )

lemma cf_cn_cov_rcomp_ArrMap_app[cat_cs_simps]:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "f ∈∘ op_cat 𝔅⦇Arr⦈" 
    and "g ∈∘ 𝔄⦇Arr⦈"
  shows "cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f, gβ¦ˆβˆ™ = 𝔖⦇ArrMapβ¦ˆβ¦‡f, π”Šβ¦‡ArrMapβ¦ˆβ¦‡gβ¦ˆβ¦ˆβˆ™"
  using assms 
  unfolding cf_cn_cov_rcomp_def cat_op_simps
  by 
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_op_simps
        cs_intro: cat_cs_intros cat_prod_cs_intros
    )

lemma cf_cn_cov_lcomp_ArrMap_vrange:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_cn_cov_lcomp β„­ 𝔖 𝔉⦇ArrMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
  using assms
  unfolding cf_cn_cov_lcomp_def
  by (intro cf_cn_cov_bcomp_ArrMap_vrange) 
    (cs_concl cs_intro: cat_cs_intros)+

lemma cf_cn_cov_rcomp_ArrMap_vrange:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "β„›βˆ˜ (cf_cn_cov_rcomp 𝔅 𝔖 π”Šβ¦‡ArrMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
  using assms
  unfolding cf_cn_cov_rcomp_def cat_op_simps
  by (intro cf_cn_cov_bcomp_ArrMap_vrange) 
    (cs_concl cs_intro: cat_cs_intros)+


subsubsectionβ€Ή
Composition of a contracovariant bifunctor and a covariant functor is a functor
β€Ί

lemma cf_cn_cov_lcomp_is_functor:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "cf_cn_cov_lcomp β„­ 𝔖 𝔉 : op_cat 𝔄 Γ—C β„­ ↦↦CΞ± 𝔇"
  using assms
  unfolding cf_cn_cov_lcomp_def cat_op_simps
  by (cs_concl cs_intro: cat_cs_intros)+

lemma cf_cn_cov_lcomp_is_functor'[cat_cs_intros]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "𝔄ℭ = op_cat 𝔄 Γ—C β„­"
  shows "cf_cn_cov_lcomp β„­ 𝔖 𝔉 : 𝔄ℭ ↦↦CΞ± 𝔇"
  using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_lcomp_is_functor)

lemma cf_cn_cov_rcomp_is_functor:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
  shows "cf_cn_cov_rcomp 𝔅 𝔖 π”Š : op_cat 𝔅 Γ—C 𝔄 ↦↦CΞ± 𝔇"
  using assms
  unfolding cf_cn_cov_rcomp_def cat_op_simps
  by (cs_concl cs_intro: cat_cs_intros)+

lemma cf_cn_cov_rcomp_is_functor'[cat_cs_intros]:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "𝔅𝔄 = op_cat 𝔅 Γ—C 𝔄"
  shows "cf_cn_cov_rcomp 𝔅 𝔖 π”Š : 𝔅𝔄 ↦↦CΞ± 𝔇"
  using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_rcomp_is_functor)


subsubsectionβ€Ή
Projection of a composition of a contracovariant bifunctor and a covariant 
functor
β€Ί

lemma cf_cn_cov_rcomp_bifunctor_proj_snd[cat_cs_simps]:
  assumes "category Ξ± 𝔅" 
    and "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows
    "cf_cn_cov_rcomp 𝔅 𝔖 π”Šop_cat 𝔅,𝔄(b,-)CF =
      (𝔖op_cat 𝔅,β„­(b,-)CF) ∘CF π”Š"
  using assms 
  unfolding cf_cn_cov_rcomp_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_cn_cov_lcomp_bifunctor_proj_snd[cat_cs_simps]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔖 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± 𝔇"
    and "b ∈∘ 𝔄⦇Obj⦈"
  shows
    "cf_cn_cov_lcomp β„­ 𝔖 𝔉op_cat 𝔄,β„­(b,-)CF =
      (𝔖op_cat 𝔅,β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)CF)"
  using assms 
  unfolding cf_cn_cov_lcomp_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)



subsectionβ€ΉComposition of bifunctorsβ€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί

definition cf_blcomp :: "V β‡’ V"
  where "cf_blcomp 𝔖 = 
    cf_lcomp (𝔖⦇HomCod⦈) 𝔖 𝔖 ∘CF  
    cf_cat_prod_21_of_3 (𝔖⦇HomCod⦈) (𝔖⦇HomCod⦈) (𝔖⦇HomCod⦈)"

definition cf_brcomp :: "V β‡’ V"
  where "cf_brcomp 𝔖 = 
    cf_rcomp (𝔖⦇HomCod⦈) 𝔖 𝔖 ∘CF
    cf_cat_prod_12_of_3 (𝔖⦇HomCod⦈) (𝔖⦇HomCod⦈) (𝔖⦇HomCod⦈)"


textβ€ΉAlternative forms of the definitions.β€Ί

lemma cf_blcomp_def':
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "cf_blcomp 𝔖 = cf_lcomp β„­ 𝔖 𝔖 ∘CF cf_cat_prod_21_of_3 β„­ β„­ β„­"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  show ?thesis
    by (cs_concl cs_simp: cat_cs_simps cf_blcomp_def cs_intro: cat_cs_intros)
qed

lemma cf_brcomp_def':
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "cf_brcomp 𝔖 = cf_rcomp β„­ 𝔖 𝔖 ∘CF cf_cat_prod_12_of_3 β„­ β„­ β„­"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  show ?thesis
    by (cs_concl cs_simp: cat_cs_simps cf_brcomp_def cs_intro: cat_cs_intros)
qed


subsubsectionβ€ΉCompositions of bifunctors are functorsβ€Ί

lemma cf_blcomp_is_functor:
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "cf_blcomp 𝔖 : β„­ Γ—C3 β„­ Γ—C3 β„­ ↦↦CΞ± β„­"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  show ?thesis
    by (cs_concl cs_simp: cat_cs_simps cf_blcomp_def' cs_intro: cat_cs_intros)
qed

lemma cf_blcomp_is_functor'[cat_cs_intros]:
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­" and "𝔄' = β„­ Γ—C3 β„­ Γ—C3 β„­"
  shows "cf_blcomp 𝔖 : 𝔄' ↦↦CΞ± β„­"
  using assms(1) unfolding assms(2) by (rule cf_blcomp_is_functor)

lemma cf_brcomp_is_functor:
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "cf_brcomp 𝔖 : β„­ Γ—C3 β„­ Γ—C3 β„­ ↦↦CΞ± β„­"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  show ?thesis
    by (cs_concl cs_simp: cat_cs_simps cf_brcomp_def' cs_intro: cat_cs_intros)
qed

lemma cf_brcomp_is_functor'[cat_cs_intros]:
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­" and "𝔄' = β„­ Γ—C3 β„­ Γ—C3 β„­"
  shows "cf_brcomp 𝔖 : 𝔄' ↦↦CΞ± β„­"
  using assms(1) unfolding assms(2) by (rule cf_brcomp_is_functor)


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_blcomp_ObjMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "vsv (cf_blcomp 𝔖⦇ObjMap⦈)"
proof-
  interpret cf_blcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_blcomp 𝔖›
    by (rule cf_blcomp_is_functor[OF assms])
  show ?thesis by auto
qed

lemma cf_brcomp_ObjMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "vsv (cf_brcomp 𝔖⦇ObjMap⦈)"
proof-
  interpret cf_brcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_brcomp 𝔖›
    by (rule cf_brcomp_is_functor[OF assms])
  show ?thesis by auto
qed
 
lemma cf_blcomp_ObjMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_blcomp 𝔖⦇ObjMap⦈) = (β„­ Γ—C3 β„­ Γ—C3 β„­)⦇Obj⦈"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_blcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_blcomp 𝔖›
    by (rule cf_blcomp_is_functor[OF assms])
  show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma cf_brcomp_ObjMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_brcomp 𝔖⦇ObjMap⦈) = (β„­ Γ—C3 β„­ Γ—C3 β„­)⦇Obj⦈"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_brcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_brcomp 𝔖›
    by (rule cf_brcomp_is_functor[OF assms])
  show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma cf_blcomp_ObjMap_app[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
    and "A = [a, b, c]∘"
    and "a ∈∘ ℭ⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "cf_blcomp 𝔖⦇ObjMapβ¦ˆβ¦‡A⦈ = (a βŠ—HM.O𝔖 b) βŠ—HM.O𝔖 c"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_blcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_blcomp 𝔖›
    by (rule cf_blcomp_is_functor[OF assms(1)])
  from assms(3-5) show ?thesis
    unfolding assms(2)
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def' 
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed

lemma cf_brcomp_ObjMap_app[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
    and "A = [a, b, c]∘"
    and "a ∈∘ ℭ⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "cf_brcomp 𝔖⦇ObjMapβ¦ˆβ¦‡A⦈ = a βŠ—HM.O𝔖 (b βŠ—HM.O𝔖 c)"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_brcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_brcomp 𝔖›
    by (rule cf_brcomp_is_functor[OF assms(1)])
  from assms(3-5) show ?thesis
    unfolding assms(2)
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_blcomp_ArrMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "vsv (cf_blcomp 𝔖⦇ArrMap⦈)"
proof-
  interpret cf_blcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_blcomp 𝔖›
    by (rule cf_blcomp_is_functor[OF assms])
  show ?thesis by auto
qed

lemma cf_brcomp_ArrMap_vsv[cat_cs_intros]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "vsv (cf_brcomp 𝔖⦇ArrMap⦈)"
proof-
  interpret cf_brcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_brcomp 𝔖›
    by (rule cf_brcomp_is_functor[OF assms])
  show ?thesis by auto
qed
 
lemma cf_blcomp_ArrMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_blcomp 𝔖⦇ArrMap⦈) = (β„­ Γ—C3 β„­ Γ—C3 β„­)⦇Arr⦈"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_blcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_blcomp 𝔖›
    by (rule cf_blcomp_is_functor[OF assms])
  show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma cf_brcomp_ArrMap_vdomain[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (cf_brcomp 𝔖⦇ArrMap⦈) = (β„­ Γ—C3 β„­ Γ—C3 β„­)⦇Arr⦈"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_brcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_brcomp 𝔖›
    by (rule cf_brcomp_is_functor[OF assms])
  show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma cf_blcomp_ArrMap_app[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
    and "F = [h, g, f]∘"
    and "h ∈∘ ℭ⦇Arr⦈"
    and "g ∈∘ ℭ⦇Arr⦈"
    and "f ∈∘ ℭ⦇Arr⦈"
  shows "cf_blcomp 𝔖⦇ArrMapβ¦ˆβ¦‡F⦈ = (h βŠ—HM.A𝔖 g) βŠ—HM.A𝔖 f"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_blcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_blcomp 𝔖›
    by (rule cf_blcomp_is_functor[OF assms(1)])
  from assms(3-5) show ?thesis
    unfolding assms(2)
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def' 
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed

lemma cf_brcomp_ArrMap_app[cat_cs_simps]: 
  assumes "𝔖 : β„­ Γ—C β„­ ↦↦CΞ± β„­"
    and "F = [h, g, f]∘"
    and "h ∈∘ ℭ⦇Arr⦈"
    and "g ∈∘ ℭ⦇Arr⦈"
    and "f ∈∘ ℭ⦇Arr⦈"
  shows "cf_brcomp 𝔖⦇ArrMapβ¦ˆβ¦‡F⦈ = h βŠ—HM.A𝔖 (g βŠ—HM.A𝔖 f)"
proof-
  interpret 𝔖: is_functor Ξ± β€Ήβ„­ Γ—C β„­β€Ί β„­ 𝔖 by (rule assms)
  interpret cf_brcomp: is_functor Ξ± β€Ήβ„­ Γ—C3 β„­ Γ—C3 β„­β€Ί β„­ β€Ήcf_brcomp 𝔖›
    by (rule cf_brcomp_is_functor[OF assms(1)])
  from assms(3-5) show ?thesis
    unfolding assms(2)
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed



subsectionβ€ΉBinatural transformationβ€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί

textβ€Ή
In this work, a β€Ήbinatural transformationβ€Ί is used to denote a natural 
transformation of bifunctors.
β€Ί

definition bnt_proj_fst :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  (β€Ή(_β‡˜_,_⇙/'(/-,_/')/NTCF)β€Ί [51, 51, 51, 51] 51)
  where "𝔑𝔄,𝔅(-,b)NTCF =
    [
      (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™),
      𝔑⦇NTDomβ¦ˆπ”„,𝔅(-,b)CF,
      𝔑⦇NTCodβ¦ˆπ”„,𝔅(-,b)CF,
      𝔄,
      𝔑⦇NTDGCod⦈
    ]∘"

definition bnt_proj_snd :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  (β€Ή(_β‡˜_,_⇙/'(/_,-/')/NTCF)β€Ί [51, 51, 51, 51] 51)
  where "𝔑𝔄,𝔅(a,-)NTCF =
    [
      (Ξ»bβˆˆβˆ˜π”…β¦‡Obj⦈. 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™),
      𝔑⦇NTDomβ¦ˆπ”„,𝔅(a,-)CF,
      𝔑⦇NTCodβ¦ˆπ”„,𝔅(a,-)CF,
      𝔅,
      𝔑⦇NTDGCod⦈
    ]∘"


textβ€ΉComponentsβ€Ί

lemma bnt_proj_fst_components:
  shows "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTMap⦈ = (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™)"
    and "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTDom⦈ = 𝔑⦇NTDomβ¦ˆπ”„,𝔅(-,b)CF"
    and "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTCod⦈ = 𝔑⦇NTCodβ¦ˆπ”„,𝔅(-,b)CF"
    and "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTDGDom⦈ = 𝔄"
    and "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTDGCod⦈ = 𝔑⦇NTDGCod⦈"
  unfolding bnt_proj_fst_def nt_field_simps by (simp_all add: nat_omega_simps)

lemma bnt_proj_snd_components:
  shows "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTMap⦈ = (Ξ»bβˆˆβˆ˜π”…β¦‡Obj⦈. 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™)"
    and "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTDom⦈ = 𝔑⦇NTDomβ¦ˆπ”„,𝔅(a,-)CF"
    and "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTCod⦈ = 𝔑⦇NTCodβ¦ˆπ”„,𝔅(a,-)CF"
    and "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTDGDom⦈ = 𝔅"
    and "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTDGCod⦈ = 𝔑⦇NTDGCod⦈"
  unfolding bnt_proj_snd_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapsβ€Ί

mk_VLambda bnt_proj_fst_components(1)[folded VLambda_vconst_on]
  |vsv bnt_proj_fst_NTMap_vsv[cat_cs_intros]|
  |vdomain bnt_proj_fst_NTMap_vdomain[cat_cs_simps]|
  |app bnt_proj_fst_NTMap_app[cat_cs_simps]|

lemma bnt_proj_fst_vrange:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "β„›βˆ˜ ((𝔑𝔄,𝔅(-,b)NTCF)⦇NTMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule assms(3))
  show ?thesis
    unfolding bnt_proj_fst_components
  proof(rule vrange_VLambda_vsubset)
    fix a assume "a ∈∘ 𝔄⦇Obj⦈"    
    with assms show "𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ ∈∘ ℭ⦇Arr⦈"
      by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
  qed
qed

mk_VLambda bnt_proj_snd_components(1)[folded VLambda_vconst_on]
  |vsv bnt_proj_snd_NTMap_vsv[intro]|
  |vdomain bnt_proj_snd_NTMap_vdomain[cat_cs_simps]|
  |app bnt_proj_snd_NTMap_app[cat_cs_simps]|

lemma bnt_proj_snd_vrange:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "β„›βˆ˜ ((𝔑𝔄,𝔅(a,-)NTCF)⦇NTMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof-
  interpret 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule assms(3))
  show ?thesis
    unfolding bnt_proj_snd_components
  proof(rule vrange_VLambda_vsubset)
    fix b assume "b ∈∘ 𝔅⦇Obj⦈"    
    with assms show "𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ ∈∘ ℭ⦇Arr⦈"
      by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
  qed
qed


subsubsectionβ€ΉBinatural transformation projection is a natural transformationβ€Ί

lemma bnt_proj_snd_is_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "𝔑𝔄,𝔅(a,-)NTCF : 𝔖𝔄,𝔅(a,-)CF ↦CF 𝔖'𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± β„­"
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule assms(3))
  show ?thesis
  proof(intro is_ntcfI')
    show "vfsequence (𝔑𝔄,𝔅(a,-)NTCF)" unfolding bnt_proj_snd_def by simp 
    show "vcard (𝔑𝔄,𝔅(a,-)NTCF) = 5β„•"
      unfolding bnt_proj_snd_def by (simp add: nat_omega_simps)
    from assms show "𝔖𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms show "𝔖'𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTMapβ¦ˆβ¦‡b⦈ :
      (𝔖𝔄,𝔅(a,-)CF)⦇ObjMapβ¦ˆβ¦‡b⦈ ↦ℭ (𝔖'𝔄,𝔅(a,-)CF)⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
      using that assms 
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
        )
    show "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ (𝔖𝔄,𝔅(a,-)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ =
      (𝔖'𝔄,𝔅(a,-)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (𝔑𝔄,𝔅(a,-)NTCF)⦇NTMapβ¦ˆβ¦‡a'⦈"
      if "f : a' ↦𝔅 b" for a' b f
      using that assms 
      by 
        (
          cs_concl 
            cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps 
            cs_intro: cat_cs_intros cat_prod_cs_intros
        )
  qed (auto simp: bnt_proj_snd_components cat_cs_simps)
qed

lemma bnt_proj_snd_is_ntcf'[cat_cs_intros]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "𝔉 = 𝔖𝔄,𝔅(a,-)CF"
    and "π”Š = 𝔖'𝔄,𝔅(a,-)CF"
  shows "𝔑𝔄,𝔅(a,-)NTCF : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
  using assms by (auto intro: bnt_proj_snd_is_ntcf)

lemma bnt_proj_fst_is_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝔑𝔄,𝔅(-,b)NTCF : 𝔖𝔄,𝔅(-,b)CF ↦CF 𝔖'𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± β„­"
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule assms(3))
  show ?thesis
  proof(intro is_ntcfI')
    show "vfsequence (𝔑𝔄,𝔅(-,b)NTCF)" unfolding bnt_proj_fst_def by simp 
    show "vcard (𝔑𝔄,𝔅(-,b)NTCF) = 5β„•"
      unfolding bnt_proj_fst_def by (simp add: nat_omega_simps)
    from assms show "𝔖𝔄,𝔅(-,b)CF : 𝔄  ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "𝔖'𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_cs_intros)
    show "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTMapβ¦ˆβ¦‡a⦈ :
      (𝔖𝔄,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ (𝔖'𝔄,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ 𝔄⦇Obj⦈" for a
      using that assms 
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
        )
    show "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTMapβ¦ˆβ¦‡b'⦈ ∘Aβ„­ (𝔖𝔄,𝔅(-,b)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ =
      (𝔖'𝔄,𝔅(-,b)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (𝔑𝔄,𝔅(-,b)NTCF)⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦𝔄 b'" for a b' f
      using that assms 
      by
        (
          cs_concl
            cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps 
            cs_intro: cat_cs_intros cat_prod_cs_intros
        )
  qed (auto simp: bnt_proj_fst_components cat_cs_simps)
qed

lemma bnt_proj_fst_is_ntcf'[cat_cs_intros]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "𝔉 = 𝔖𝔄,𝔅(-,b)CF"
    and "π”Š = 𝔖'𝔄,𝔅(-,b)CF"
    and "𝔄' = 𝔄"
  shows "𝔑𝔄,𝔅(-,b)NTCF : 𝔉 ↦CF π”Š : 𝔄' ↦↦CΞ± β„­"
  using assms(1-4) unfolding assms(5-7) by (rule bnt_proj_fst_is_ntcf)


subsubsectionβ€ΉArray binatural transformation is a natural transformationβ€Ί

lemma ntcf_array_is_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔖 : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "vfsequence 𝔑"
    and "vcard 𝔑 = 5β„•"
    and "𝔑⦇NTDom⦈ = 𝔖"
    and "𝔑⦇NTCod⦈ = 𝔖'"
    and "𝔑⦇NTDGDom⦈ = 𝔄 Γ—C 𝔅"
    and "𝔑⦇NTDGCod⦈ = β„­"
    and "vsv (𝔑⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (𝔑⦇NTMap⦈) = (𝔄 Γ—C 𝔅)⦇Obj⦈"
    and "β‹€a b. ⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔅⦇Obj⦈ ⟧ ⟹
      𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ : 𝔖⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ ↦ℭ 𝔖'⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
    and "β‹€a. a ∈∘ 𝔄⦇Obj⦈ ⟹
      𝔑𝔄,𝔅(a,-)NTCF : 𝔖𝔄,𝔅(a,-)CF ↦CF 𝔖'𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± β„­"
    and "β‹€b. b ∈∘ 𝔅⦇Obj⦈ ⟹
      𝔑𝔄,𝔅(-,b)NTCF : 𝔖𝔄,𝔅(-,b)CF ↦CF 𝔖'𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± β„­"  
  shows "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret 𝔑: vsv ‹𝔑⦇NTMapβ¦ˆβ€Ί by (rule assms(11))  

  have [cat_cs_intros]:
    "⟦ a ∈∘ 𝔄⦇Obj⦈; b ∈∘ 𝔅⦇Obj⦈; A = 𝔖⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™; B = 𝔖'⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ ⟧ ⟹
      𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ : A ↦ℭ B"
    for a b A B
    by (auto intro: assms(13))

  show ?thesis
  proof(intro is_ntcfI')

    show "𝔑⦇NTMapβ¦ˆβ¦‡ab⦈ : 𝔖⦇ObjMapβ¦ˆβ¦‡ab⦈ ↦ℭ 𝔖'⦇ObjMapβ¦ˆβ¦‡ab⦈"
      if "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈" for ab
    proof-
      from that obtain a b 
        where ab_def: "ab = [a, b]∘" and a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF assms(1,2)])
      from a b show ?thesis unfolding ab_def by (rule assms(13))
    qed
    
    show
      "𝔑⦇NTMapβ¦ˆβ¦‡a'b'⦈ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡gf⦈ = 𝔖'⦇ArrMapβ¦ˆβ¦‡gf⦈ ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡ab⦈"
      if "gf : ab ↦𝔄 Γ—C 𝔅 a'b'" for ab a'b' gf
    proof-
      from that obtain g f a b a' b'
        where gf_def: "gf = [g, f]∘" 
          and ab_def: "ab = [a, b]∘" 
          and a'b'_def: "a'b' = [a', b']∘"
          and g: "g : a ↦𝔄 a'"
          and f: "f : b ↦𝔅 b'"
        by (elim cat_prod_2_is_arrE[OF assms(1,2)])
      then have a: "a ∈∘ 𝔄⦇Obj⦈" 
        and a': "a' ∈∘ 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈" 
        and b': "b' ∈∘ 𝔅⦇Obj⦈" 
        by auto
      show ?thesis
        unfolding gf_def ab_def a'b'_def
      proof-
        from is_ntcfD'(13)[OF assms(15)[OF b] g] g f assms(1,2,3,4) 
        have [cat_cs_simps]:
          "(𝔖'⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™ ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™) =
            (𝔑⦇NTMapβ¦ˆβ¦‡a', bβ¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™)"
          by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
        from is_ntcfD'(13)[OF assms(14)[OF a'] f] g f assms(1,2) 
        have 𝔖'𝔑:
          "𝔖'⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈, fβ¦ˆβˆ™ ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡a', bβ¦ˆβˆ™ =
            𝔑⦇NTMapβ¦ˆβ¦‡a', b'β¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈,fβ¦ˆβˆ™"
          by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
        from g f assms(1-4) have [cat_cs_simps]: 
          "𝔖'⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈, fβ¦ˆβˆ™ ∘Aβ„­ (𝔑⦇NTMapβ¦ˆβ¦‡a', bβ¦ˆβˆ™ ∘Aβ„­ q) =
            𝔑⦇NTMapβ¦ˆβ¦‡a', b'β¦ˆβˆ™ ∘Aβ„­ (𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈,fβ¦ˆβˆ™ ∘Aβ„­ q)"
          if "q : r ↦ℭ 𝔖⦇ObjMapβ¦ˆβ¦‡a', bβ¦ˆβˆ™" for q r
          using that
          by
            (
              cs_concl
                cs_simp: 𝔖'𝔑 category.cat_Comp_assoc[symmetric]  
                cs_intro: cat_cs_intros cat_prod_cs_intros
            ) 

        from assms(1-4) g f have 
          "𝔖'⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈, fβ¦ˆβˆ™ ∘Aβ„­ 𝔖'⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™ =
            𝔖'⦇ArrMapβ¦ˆβ¦‡[𝔄⦇CIdβ¦ˆβ¦‡a'⦈, f]∘ ∘A𝔄 Γ—C 𝔅 [g, 𝔅⦇CIdβ¦ˆβ¦‡b⦈]∘⦈"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
            ) 
        also from assms(1-4) g f have "… = 𝔖'⦇ArrMap⦈ ⦇g, fβ¦ˆβˆ™"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_prod_cs_simps
                cs_intro: cat_cs_intros cat_prod_cs_intros
            )
        finally have 𝔖'_gf: "𝔖'⦇ArrMap⦈ ⦇g, fβ¦ˆβˆ™ =
          𝔖'⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈, fβ¦ˆβˆ™ ∘Aβ„­ 𝔖'⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
          by simp
        from assms(1-4) g f have 
          "𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈, fβ¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™ =
            𝔖⦇ArrMapβ¦ˆβ¦‡[𝔄⦇CIdβ¦ˆβ¦‡a'⦈, f]∘ ∘A𝔄 Γ—C 𝔅 [g, 𝔅⦇CIdβ¦ˆβ¦‡b⦈]∘⦈"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
            ) 
        also from assms(1-4) g f have "… = 𝔖⦇ArrMap⦈ ⦇g, fβ¦ˆβˆ™"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_prod_cs_simps
                cs_intro: cat_cs_intros cat_prod_cs_intros
            )
        finally have 𝔖_gf: "𝔖⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ =
          𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈, fβ¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
          by simp
        from assms(1-4) g f assms(13)[OF a b] assms(13)[OF a' b] have 
          "𝔖'⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ =
            (𝔖'⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈, fβ¦ˆβˆ™ ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡a', bβ¦ˆβˆ™) ∘Aβ„­
            𝔖⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
          unfolding 𝔖'_gf 
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
            )
        also from assms(1-4) g f have 
          "… = (𝔑⦇NTMapβ¦ˆβ¦‡a', b'β¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈,fβ¦ˆβˆ™) ∘Aβ„­
            𝔖⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
            )
        also from assms(1-4) g f assms(13)[OF a' b'] have 
          "… = 𝔑⦇NTMapβ¦ˆβ¦‡a', b'β¦ˆβˆ™ ∘Aβ„­
            (𝔖⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡a'⦈,fβ¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡g, 𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™)"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
            )
        also from assms(1-4) g f assms(13)[OF a' b'] have 
          "… = 𝔑⦇NTMapβ¦ˆβ¦‡a', b'β¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™"
          unfolding 𝔖_gf[symmetric] by simp
        finally show 
          "𝔑⦇NTMapβ¦ˆβ¦‡a', b'β¦ˆβˆ™ ∘Aβ„­ 𝔖⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ =
            𝔖'⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
          by simp
      qed
    qed

  qed (auto simp: assms)

qed


subsubsectionβ€ΉBinatural transformation projections and isomorphismsβ€Ί

lemma is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "β‹€a. a ∈∘ 𝔄⦇Obj⦈ ⟹ 
      𝔑𝔄,𝔅(a,-)NTCF : 𝔖𝔄,𝔅(a,-)CF ↦CF.iso 𝔖'𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± β„­"
  shows "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  show ?thesis  
  proof(intro is_iso_ntcfI)
    show "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" by (rule assms(3))
    fix ab assume "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
    then obtain a b 
      where ab_def: "ab = [a, b]∘" and a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈"
      by (elim cat_prod_2_ObjE[OF assms(1,2)])
    interpret 𝔑a: is_iso_ntcf 
      Ξ± 𝔅 β„­ ‹𝔖𝔄,𝔅(a,-)CFβ€Ί ‹𝔖'𝔄,𝔅(a,-)CFβ€Ί ‹𝔑𝔄,𝔅(a,-)NTCFβ€Ί
      by (rule assms(4)[OF a])
    from b have 𝔑ab: "𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = (𝔑𝔄,𝔅(a,-)NTCF)⦇NTMapβ¦ˆβ¦‡b⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    from 𝔑a.iso_ntcf_is_arr_isomorphism[OF b] assms(1,2,3) a b show
      "𝔑⦇NTMapβ¦ˆβ¦‡ab⦈ : 𝔖⦇ObjMapβ¦ˆβ¦‡ab⦈ ↦isoβ„­ 𝔖'⦇ObjMapβ¦ˆβ¦‡ab⦈" 
      by (cs_prems cs_simp: cat_cs_simps ab_def cs_intro: cat_prod_cs_intros)
  qed
qed

lemma is_iso_ntcf_if_bnt_proj_fst_is_iso_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "β‹€b. b ∈∘ 𝔅⦇Obj⦈ ⟹
      𝔑𝔄,𝔅(-,b)NTCF : 𝔖𝔄,𝔅(-,b)CF ↦CF.iso 𝔖'𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± β„­"
  shows "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  show ?thesis  
  proof(intro is_iso_ntcfI)
    show "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" by (rule assms(3))
    fix ab assume "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
    then obtain a b 
      where ab_def: "ab = [a, b]∘" and a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈"
      by (elim cat_prod_2_ObjE[OF assms(1,2)])
    interpret 𝔑a: is_iso_ntcf 
      Ξ± 𝔄 β„­ ‹𝔖𝔄,𝔅(-,b)CFβ€Ί ‹𝔖'𝔄,𝔅(-,b)CFβ€Ί ‹𝔑𝔄,𝔅(-,b)NTCFβ€Ί
      by (rule assms(4)[OF b])
    from b have 𝔑ab: "𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = (𝔑𝔄,𝔅(a,-)NTCF)⦇NTMapβ¦ˆβ¦‡b⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from 𝔑a.iso_ntcf_is_arr_isomorphism[OF a] assms(1,2,3) a b show
      "𝔑⦇NTMapβ¦ˆβ¦‡ab⦈ : 𝔖⦇ObjMapβ¦ˆβ¦‡ab⦈ ↦isoβ„­ 𝔖'⦇ObjMapβ¦ˆβ¦‡ab⦈"
      unfolding ab_def 
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
  qed
qed

lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "𝔑𝔄,𝔅(a,-)NTCF :
    𝔖𝔄,𝔅(a,-)CF ↦CF.iso 𝔖'𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± β„­"
proof(intro is_iso_ntcfI)
  from assms show "𝔑𝔄,𝔅(a,-)NTCF :
    𝔖𝔄,𝔅(a,-)CF ↦CF 𝔖'𝔄,𝔅(a,-)CF : 𝔅 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
  show "(𝔑𝔄,𝔅(a,-)NTCF)⦇NTMapβ¦ˆβ¦‡b⦈ :
    (𝔖𝔄,𝔅(a,-)CF)⦇ObjMapβ¦ˆβ¦‡b⦈ ↦isoβ„­ (𝔖'𝔄,𝔅(a,-)CF)⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "b ∈∘ 𝔅⦇Obj⦈" for b
    using assms that 
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
      )
qed

lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "𝔉 = 𝔖𝔄,𝔅(a,-)CF"
    and "π”Š = 𝔖'𝔄,𝔅(a,-)CF"
    and "𝔅' = 𝔅"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "𝔑𝔄,𝔅(a,-)NTCF : 𝔉 ↦CF.iso π”Š : 𝔅' ↦↦CΞ± β„­"
  unfolding assms(4-6) 
  by (rule bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])

lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝔑𝔄,𝔅(-,b)NTCF :
    𝔖𝔄,𝔅(-,b)CF ↦CF.iso 𝔖'𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± β„­"
proof(intro is_iso_ntcfI)
  from assms show "𝔑𝔄,𝔅(-,b)NTCF :
    𝔖𝔄,𝔅(-,b)CF ↦CF 𝔖'𝔄,𝔅(-,b)CF : 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
  show "(𝔑𝔄,𝔅(-,b)NTCF)⦇NTMapβ¦ˆβ¦‡a⦈ :
    (𝔖𝔄,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isoβ„­ (𝔖'𝔄,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using assms that 
    by
      (
        cs_concl
          cs_simp: cat_cs_simps
          cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
      )
qed

lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "𝔉 = 𝔖𝔄,𝔅(-,b)CF"
    and "π”Š = 𝔖'𝔄,𝔅(-,b)CF"
    and "𝔄' = 𝔄"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝔑𝔄,𝔅(-,b)NTCF : 𝔉 ↦CF.iso π”Š : 𝔄' ↦↦CΞ± β„­"
  unfolding assms(4-6) 
  by (rule bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])



subsectionβ€ΉBinatural transformation flipβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition bnt_flip :: "V β‡’ V β‡’ V β‡’ V"
  where "bnt_flip 𝔄 𝔅 𝔑 =
    [
      fflip (𝔑⦇NTMap⦈), 
      bifunctor_flip 𝔄 𝔅 (𝔑⦇NTDom⦈),
      bifunctor_flip 𝔄 𝔅 (𝔑⦇NTCod⦈),
      𝔅 Γ—C 𝔄,
      𝔑⦇NTDGCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma bnt_flip_components:
  shows "bnt_flip 𝔄 𝔅 𝔑⦇NTMap⦈ = fflip (𝔑⦇NTMap⦈)"
    and "bnt_flip 𝔄 𝔅 𝔑⦇NTDom⦈ = bifunctor_flip 𝔄 𝔅 (𝔑⦇NTDom⦈)"
    and "bnt_flip 𝔄 𝔅 𝔑⦇NTCod⦈ = bifunctor_flip 𝔄 𝔅 (𝔑⦇NTCod⦈)"
    and "bnt_flip 𝔄 𝔅 𝔑⦇NTDGDom⦈ = 𝔅 Γ—C 𝔄"
    and "bnt_flip 𝔄 𝔅 𝔑⦇NTDGCod⦈ = 𝔑⦇NTDGCod⦈"
  unfolding bnt_flip_def nt_field_simps by (simp_all add: nat_omega_simps)

context 
  fixes Ξ± 𝔄 𝔅 β„­ 𝔖 𝔖' 𝔑
  assumes 𝔑: "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
begin

interpretation 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule 𝔑)

lemmas bnt_flip_components' = 
  bnt_flip_components[where 𝔄=𝔄 and 𝔅=𝔅 and 𝔑=𝔑, unfolded cat_cs_simps]

lemmas [cat_cs_simps] = bnt_flip_components'(2-5)

end


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma bnt_flip_NTMap_vsv[cat_cs_intros]: "vsv (bnt_flip 𝔄 𝔅 𝔑⦇NTMap⦈)"
  unfolding bnt_flip_components by (rule fflip_vsv)

lemma bnt_flip_NTMap_app:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "bnt_flip 𝔄 𝔅 𝔑⦇NTMapβ¦ˆβ¦‡b, aβ¦ˆβˆ™ = 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
  using assms
  unfolding bnt_flip_components
  by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)

lemma bnt_flip_NTMap_app'[cat_cs_simps]:
  assumes "ba = [b, a]∘"
    and "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "bnt_flip 𝔄 𝔅 𝔑⦇NTMapβ¦ˆβ¦‡ba⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
  using assms(2-6) unfolding assms(1) by (rule bnt_flip_NTMap_app)

lemma bnt_flip_NTMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
  shows "π’Ÿβˆ˜ (bnt_flip 𝔄 𝔅 𝔑⦇NTMap⦈) = (𝔅 Γ—C 𝔄)⦇Obj⦈"
  using assms
  unfolding bnt_flip_components
  by (cs_concl cs_simp: V_cs_simps cat_cs_simps)

lemma bnt_flip_NTMap_vrange[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
  shows "β„›βˆ˜ (bnt_flip 𝔄 𝔅 𝔑⦇NTMap⦈) = β„›βˆ˜ (𝔑⦇NTMap⦈)"
proof-
  
  interpret 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule assms(3))

  show ?thesis
  proof(intro vsubset_antisym)

    show "β„›βˆ˜ (bnt_flip 𝔄 𝔅 𝔑⦇NTMap⦈) βŠ†βˆ˜ β„›βˆ˜ (𝔑⦇NTMap⦈)"
    proof
      (
        intro vsv.vsv_vrange_vsubset, 
        unfold bnt_flip_NTMap_vdomain[OF assms]
      )
      fix ba assume "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
      then obtain a b
        where ba_def: "ba = [b, a]∘" 
          and b: "b ∈∘ 𝔅⦇Obj⦈" 
          and a: "a ∈∘ 𝔄⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF assms(2,1)])
      from 𝔑.ntcf_NTMap_vsv assms a b show 
        "bnt_flip 𝔄 𝔅 𝔑⦇NTMapβ¦ˆβ¦‡ba⦈ ∈∘ β„›βˆ˜ (𝔑⦇NTMap⦈)"
        unfolding ba_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros)

    show "β„›βˆ˜ (𝔑⦇NTMap⦈) βŠ†βˆ˜ β„›βˆ˜ (bnt_flip 𝔄 𝔅 𝔑⦇NTMap⦈)"
    proof(intro vsv.vsv_vrange_vsubset, unfold 𝔑.ntcf_NTMap_vdomain)
      fix ab assume prems: "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
      then obtain a b 
        where ab_def: "ab = [a, b]∘" 
          and a: "a ∈∘ 𝔄⦇Obj⦈" 
          and b: "b ∈∘ 𝔅⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF assms(1,2)])
      from assms a b have ba: "[b, a]∘ ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈"
        by (cs_concl cs_intro: cat_prod_cs_intros)
      from assms bnt_flip_NTMap_vsv prems a b ba show 
        "𝔑⦇NTMapβ¦ˆβ¦‡ab⦈ ∈∘ β„›βˆ˜ (bnt_flip 𝔄 𝔅 𝔑⦇NTMap⦈)"
        unfolding ab_def 
        by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
    qed auto

  qed

qed


subsubsectionβ€ΉBinatural transformation flip natural transformation mapβ€Ί

lemma bnt_flip_NTMap_is_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
  shows "bnt_flip 𝔄 𝔅 𝔑 : 
    bifunctor_flip 𝔄 𝔅 𝔖 ↦CF bifunctor_flip 𝔄 𝔅 𝔖' : 
    𝔅 Γ—C 𝔄 ↦↦CΞ± β„­"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))

  interpret 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule assms(3))

  show ?thesis
  proof(intro is_ntcfI')
    show "vfsequence (bnt_flip 𝔄 𝔅 𝔑)" unfolding bnt_flip_def by simp
    show "vcard (bnt_flip 𝔄 𝔅 𝔑) = 5β„•"
      unfolding bnt_flip_def by (simp add: nat_omega_simps)
    show "bnt_flip 𝔄 𝔅 𝔑⦇NTMapβ¦ˆβ¦‡ba⦈ :
      bifunctor_flip 𝔄 𝔅 𝔖⦇ObjMapβ¦ˆβ¦‡ba⦈ ↦ℭ
      bifunctor_flip 𝔄 𝔅 𝔖'⦇ObjMapβ¦ˆβ¦‡ba⦈"
      if "ba ∈∘ (𝔅 Γ—C 𝔄)⦇Obj⦈" for ba
    proof-
      from that obtain b a 
        where ba_def: "ba = [b, a]∘" 
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and a: "a ∈∘ 𝔄⦇Obj⦈"
        by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
      from assms a b show ?thesis 
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps ba_def 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
    show 
      "bnt_flip 𝔄 𝔅 𝔑⦇NTMapβ¦ˆβ¦‡b'a'⦈ ∘Aβ„­ bifunctor_flip 𝔄 𝔅 𝔖⦇ArrMapβ¦ˆβ¦‡gf⦈ =
        bifunctor_flip 𝔄 𝔅 𝔖'⦇ArrMapβ¦ˆβ¦‡gf⦈ ∘Aβ„­ bnt_flip 𝔄 𝔅 𝔑⦇NTMapβ¦ˆβ¦‡ba⦈"
      if "gf : ba ↦𝔅 Γ—C 𝔄 b'a'" for ba b'a' gf
    proof-
      from that obtain g f a b a' b'
        where gf_def: "gf = [g, f]∘"
          and ba_def: "ba = [b, a]∘"
          and b'a'_def: "b'a' = [b', a']∘"
          and g: "g : b ↦𝔅 b'"
          and f: "f : a ↦𝔄 a'"
        by (elim cat_prod_2_is_arrE[OF assms(2,1)])
      from assms g f show ?thesis
        unfolding gf_def ba_def b'a'_def
        by 
          ( 
            cs_concl 
              cs_simp: cat_cs_simps cat_cs_simps 𝔑.ntcf_Comp_commute
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed

  qed (use assms in β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβ€Ί)+

qed

lemma bnt_flip_NTMap_is_ntcf'[cat_cs_intros]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "𝒯 = bifunctor_flip 𝔄 𝔅 𝔖"
    and "𝒯' = bifunctor_flip 𝔄 𝔅 𝔖'"
    and "𝔇 = 𝔅 Γ—C 𝔄"
  shows "bnt_flip 𝔄 𝔅 𝔑 : 𝒯 ↦CF 𝒯' : 𝔇 ↦↦CΞ± β„­"
  using assms(1-3) unfolding assms(4-6) by (intro bnt_flip_NTMap_is_ntcf)


subsubsectionβ€ΉDouble-flip of a binatural transformationβ€Ί

lemma bnt_flip_flip[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
  shows "bnt_flip 𝔅 𝔄 (bnt_flip 𝔄 𝔅 𝔑) = 𝔑"
proof(rule ntcf_eqI)
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± ‹𝔄 Γ—C 𝔅› β„­ 𝔖 𝔖' 𝔑 by (rule assms(3))
  from assms show
    "bnt_flip 𝔅 𝔄 (bnt_flip 𝔄 𝔅 𝔑) : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have dom_lhs:
    "π’Ÿβˆ˜ (bnt_flip 𝔅 𝔄 (bnt_flip 𝔄 𝔅 𝔑)⦇NTMap⦈) = (𝔄 Γ—C 𝔅)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  show "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" by (rule assms(3))
  then have dom_rhs: "π’Ÿβˆ˜ (𝔑⦇NTMap⦈) = (𝔄 Γ—C 𝔅)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  show "bnt_flip 𝔅 𝔄 (bnt_flip 𝔄 𝔅 𝔑)⦇NTMap⦈ = 𝔑⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix ab assume "ab ∈∘ (𝔄 Γ—C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" 
        and a: "a ∈∘ 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈" 
      by (rule cat_prod_2_ObjE[OF assms(1,2)])
    from assms a b show 
      "bnt_flip 𝔅 𝔄 (bnt_flip 𝔄 𝔅 𝔑)⦇NTMapβ¦ˆβ¦‡ab⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡ab⦈" 
      by (cs_concl cs_simp: cat_cs_simps ab_def cs_intro: cat_cs_intros)
  qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
qed simp_all


subsubsectionβ€ΉA projection of a flip of a binatural transformationβ€Ί

lemma bnt_flip_proj_snd[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "bnt_flip 𝔄 𝔅 𝔑𝔅,𝔄(b,-)NTCF = 𝔑𝔄,𝔅(-,b)NTCF"
proof(rule ntcf_eqI)
  from assms show "bnt_flip 𝔄 𝔅 𝔑𝔅,𝔄(b,-)NTCF :
    bifunctor_flip 𝔄 𝔅 𝔖𝔅,𝔄(b,-)CF ↦CF bifunctor_flip 𝔄 𝔅 𝔖'𝔅,𝔄(b,-)CF :
    𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  from assms show "𝔑𝔄,𝔅(-,b)NTCF :
    bifunctor_flip 𝔄 𝔅 𝔖𝔅,𝔄(b,-)CF ↦CF bifunctor_flip 𝔄 𝔅 𝔖'𝔅,𝔄(b,-)CF :
    𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms have dom_lhs: 
    "π’Ÿβˆ˜ ((bnt_flip 𝔄 𝔅 𝔑𝔅,𝔄(b,-)NTCF)⦇NTMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from assms have dom_rhs: "π’Ÿβˆ˜ ((𝔑𝔄,𝔅(-,b)NTCF)⦇NTMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  show "(bnt_flip 𝔄 𝔅 𝔑𝔅,𝔄(b,-)NTCF)⦇NTMap⦈ = (𝔑𝔄,𝔅(-,b)NTCF)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume "a ∈∘ 𝔄⦇Obj⦈"
    with assms show 
      "(bnt_flip 𝔄 𝔅 𝔑𝔅,𝔄(b,-)NTCF)⦇NTMapβ¦ˆβ¦‡a⦈ = (𝔑𝔄,𝔅(-,b)NTCF)⦇NTMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps)
  qed (auto simp: cat_cs_intros)
qed simp_all

lemma bnt_flip_proj_fst[cat_cs_simps]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­" 
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "bnt_flip 𝔄 𝔅 𝔑𝔅,𝔄(-,a)NTCF = 𝔑𝔄,𝔅(a,-)NTCF"
proof-
  from assms have f_𝔑: 
    "bnt_flip 𝔄 𝔅 𝔑 :
      bifunctor_flip 𝔄 𝔅 𝔖 ↦CF bifunctor_flip 𝔄 𝔅 𝔖' :
      𝔅 Γ—C 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  show ?thesis
    by 
      (
        rule 
          bnt_flip_proj_snd
            [
              OF assms(2,1) f_𝔑 assms(4), 
              unfolded bnt_flip_flip[OF assms(1,2,3)],
              symmetric
            ]
      )
qed


subsubsectionβ€ΉA flip of a binatural isomorphismβ€Ί

lemma bnt_flip_is_iso_ntcf:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
  shows "bnt_flip 𝔄 𝔅 𝔑 :
    bifunctor_flip 𝔄 𝔅 𝔖 ↦CF.iso bifunctor_flip 𝔄 𝔅 𝔖' : 
    𝔅 Γ—C 𝔄 ↦↦CΞ± β„­"
proof(rule is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf)
  from assms show f_𝔑: "bnt_flip 𝔄 𝔅 𝔑 :
    bifunctor_flip 𝔄 𝔅 𝔖 ↦CF bifunctor_flip 𝔄 𝔅 𝔖' :
    𝔅 Γ—C 𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
  fix a assume "a ∈∘ 𝔅⦇Obj⦈"
  with assms f_𝔑 show 
    "bnt_flip 𝔄 𝔅 𝔑𝔅,𝔄(a,-)NTCF :
      bifunctor_flip 𝔄 𝔅 𝔖𝔅,𝔄(a,-)CF ↦CF.iso
      bifunctor_flip 𝔄 𝔅 𝔖'𝔅,𝔄(a,-)CF :
      𝔄 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
qed (simp_all add: assms)

lemma bnt_flip_is_iso_ntcf'[cat_cs_intros]:
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "𝔑 : 𝔖 ↦CF.iso 𝔖' : 𝔄 Γ—C 𝔅 ↦↦CΞ± β„­"
    and "𝔉 = bifunctor_flip 𝔄 𝔅 𝔖"
    and "π”Š = bifunctor_flip 𝔄 𝔅 𝔖'"
    and "𝔇 = 𝔅 Γ—C 𝔄"
  shows "bnt_flip 𝔄 𝔅 𝔑 : 𝔉 ↦CF.iso π”Š : 𝔇 ↦↦CΞ± β„­"
  using bnt_flip_is_iso_ntcf[OF assms(1-3)] unfolding assms(4-6) by simp

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Subcategory

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉSubcategoryβ€Ί
theory CZH_ECAT_Subcategory
  imports 
    CZH_ECAT_Functor
    CZH_Foundations.CZH_SMC_Subsemicategory
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems cat_sub_cs_intros
named_theorems cat_sub_bw_cs_intros
named_theorems cat_sub_fw_cs_intros
named_theorems cat_sub_bw_cs_simps



subsectionβ€ΉSimple subcategoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.β€Ί

locale subcategory = sdg: category Ξ± 𝔅 + dg: category Ξ± β„­ for Ξ± 𝔅 β„­  +
  assumes subcat_subsemicategory: "cat_smc 𝔅 βŠ†SMCΞ± cat_smc β„­" 
    and subcat_CId: "a ∈∘ 𝔅⦇Obj⦈ ⟹ 𝔅⦇CIdβ¦ˆβ¦‡a⦈ = ℭ⦇CIdβ¦ˆβ¦‡a⦈"

abbreviation is_subcategory ("(_/ βŠ†CΔ± _)" [51, 51] 50)
  where "𝔅 βŠ†CΞ± β„­ ≑ subcategory Ξ± 𝔅 β„­"


textβ€ΉRules.β€Ί

lemma (in subcategory) subcategory_axioms'[cat_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔅' = 𝔅"
  shows "𝔅' βŠ†CΞ±' β„­"
  unfolding assms by (rule subcategory_axioms)

lemma (in subcategory) subcategory_axioms''[cat_cs_intros]:
  assumes "Ξ±' = Ξ±" and "β„­' = β„­"
  shows "𝔅 βŠ†CΞ±' β„­'"
  unfolding assms by (rule subcategory_axioms)

mk_ide rf subcategory_def[unfolded subcategory_axioms_def]
  |intro subcategoryI[intro!]|
  |dest subcategoryD[dest]|
  |elim subcategoryE[elim!]|

lemmas [cat_sub_cs_intros] = subcategoryD(1,2)

lemma subcategoryI':
  assumes "category Ξ± 𝔅"
    and "category Ξ± β„­"
    and "β‹€a. a ∈∘ 𝔅⦇Obj⦈ ⟹ a ∈∘ ℭ⦇Obj⦈"
    and "β‹€a b f. f : a ↦𝔅 b ⟹ f : a ↦ℭ b"
    and "β‹€b c g a f. ⟦ g : b ↦𝔅 c; f : a ↦𝔅 b ⟧ ⟹
      g ∘A𝔅 f = g ∘Aβ„­ f"
    and "β‹€a. a ∈∘ 𝔅⦇Obj⦈ ⟹ 𝔅⦇CIdβ¦ˆβ¦‡a⦈ = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
  shows "𝔅 βŠ†CΞ± β„­"
proof-
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))  
  show ?thesis
    by 
      (
        intro subcategoryI subsemicategoryI', 
        unfold slicing_simps; 
        (intro 𝔅.cat_semicategory β„­.cat_semicategory assms)?
      )
qed


textβ€ΉA subcategory is a subsemicategory.β€Ί

context subcategory
begin

interpretation subsmc: subsemicategory Ξ± β€Ήcat_smc 𝔅› β€Ήcat_smc β„­β€Ί
  by (rule subcat_subsemicategory)

lemmas_with [unfolded slicing_simps slicing_commute]:
  subcat_Obj_vsubset = subsmc.subsmc_Obj_vsubset
  and subcat_is_arr_vsubset = subsmc.subsmc_is_arr_vsubset
  and subcat_subdigraph_op_dg_op_dg = subsmc.subsmc_subdigraph_op_dg_op_dg
  and subcat_objD = subsmc.subsmc_objD
  and subcat_arrD = subsmc.subsmc_arrD
  and subcat_dom_simp = subsmc.subsmc_dom_simp
  and subcat_cod_simp = subsmc.subsmc_cod_simp
  and subcat_is_arrD = subsmc.subsmc_is_arrD

lemmas_with [unfolded slicing_simps slicing_commute]:
  subcat_Comp_simp = subsmc.subsmc_Comp_simp
  and subcat_is_idem_arrD = subsmc.subsmc_is_idem_arrD

end

lemmas [cat_sub_fw_cs_intros] = 
  subcategory.subcat_Obj_vsubset
  subcategory.subcat_is_arr_vsubset
  subcategory.subcat_objD
  subcategory.subcat_arrD
  subcategory.subcat_is_arrD

lemmas [cat_sub_bw_cs_simps] =
  subcategory.subcat_dom_simp
  subcategory.subcat_cod_simp

lemmas [cat_sub_fw_cs_intros] = 
  subcategory.subcat_is_idem_arrD

lemmas [cat_sub_bw_cs_simps] = 
  subcategory.subcat_Comp_simp


textβ€ΉThe opposite subcategory.β€Ί

lemma (in subcategory) subcat_subcategory_op_cat: "op_cat 𝔅 βŠ†CΞ± op_cat β„­"
proof(rule subcategoryI)
  show "cat_smc (op_cat 𝔅) βŠ†SMCΞ± cat_smc (op_cat β„­)"
    unfolding slicing_commute[symmetric]
    by (intro subsmc_subsemicategory_op_smc subcat_subsemicategory)    
qed (simp_all add: sdg.category_op dg.category_op cat_op_simps subcat_CId)

lemmas subcat_subcategory_op_cat[intro] = subcategory.subcat_subcategory_op_cat


textβ€ΉElementary properties.β€Ί

lemma (in subcategory) subcat_CId_is_arr[intro]:
  assumes "a ∈∘ 𝔅⦇Obj⦈"
  shows "ℭ⦇CIdβ¦ˆβ¦‡a⦈ : a ↦𝔅 a"
proof-
  from assms have 𝔅ℭ: "𝔅⦇CIdβ¦ˆβ¦‡a⦈ = ℭ⦇CIdβ¦ˆβ¦‡a⦈" by (simp add: subcat_CId)
  from assms have "𝔅⦇CIdβ¦ˆβ¦‡a⦈ : a ↦𝔅 a" by (auto intro: cat_cs_intros)
  then show ?thesis unfolding 𝔅ℭ by simp
qed


textβ€ΉFurther rules.β€Ί

lemma (in subcategory) subcat_CId_simp[cat_sub_bw_cs_simps]:
  assumes "a ∈∘ 𝔅⦇Obj⦈" 
  shows "𝔅⦇CIdβ¦ˆβ¦‡a⦈ = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
  using assms by (simp add: subcat_CId)

lemmas [cat_sub_bw_cs_simps] = subcategory.subcat_CId_simp 

lemma (in subcategory) subcat_is_right_inverseD[cat_sub_fw_cs_intros]: 
  assumes "is_right_inverse 𝔅 g f" 
  shows "is_right_inverse β„­ g f"
  using assms subcategory_axioms
  by (elim is_right_inverseE, intro is_right_inverseI)
    (
      cs_concl 
        cs_simp: cat_sub_bw_cs_simps[symmetric]
        cs_intro: cat_sub_fw_cs_intros cat_cs_intros cat_sub_cs_intros
    )

lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_right_inverseD

lemma (in subcategory) subcat_is_left_inverseD[cat_sub_fw_cs_intros]: 
  assumes "is_left_inverse 𝔅 g f" 
  shows "is_left_inverse β„­ g f"
proof-
  have "op_cat 𝔅 βŠ†CΞ± op_cat β„­" by (simp add: subcat_subcategory_op_cat)
  from subcategory.subcat_is_right_inverseD[OF this] show ?thesis 
    unfolding cat_op_simps using assms.
qed

lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_left_inverseD

lemma (in subcategory) subcat_is_inverseD[cat_sub_fw_cs_intros]: 
  assumes "is_inverse 𝔅 g f" 
  shows "is_inverse β„­ g f"
  using assms subcategory_axioms
  by (elim is_inverseE, intro is_inverseI)
    (
      cs_concl 
        cs_simp: cat_sub_bw_cs_simps[symmetric]
        cs_intro: cat_sub_fw_cs_intros cat_cs_intros cat_sub_cs_intros
    )

lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_inverseD

lemma (in subcategory) subcat_is_arr_isomorphismD[cat_sub_fw_cs_intros]:
  assumes "f : a ↦iso𝔅 b" 
  shows "f : a ↦isoβ„­ b"
proof(intro is_arr_isomorphismI)
  from subcategory_axioms is_arr_isomorphismD(1)[OF assms] show "f : a ↦ℭ b"
    by 
      (
        cs_concl 
          cs_simp: cat_sub_bw_cs_simps[symmetric] cs_intro: cat_sub_fw_cs_intros
      )
  from assms have "is_inverse 𝔅 (fΒ―C𝔅) f"
    by (rule sdg.cat_the_inverse_is_inverse)
  with subcategory_axioms show "is_inverse β„­ (fΒ―C𝔅) f"
    by (elim is_inverseE, intro is_inverseI)
      (
        cs_concl 
          cs_simp: cat_sub_bw_cs_simps[symmetric] 
          cs_intro: cat_sub_fw_cs_intros cat_cs_intros
      )
qed

lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_arr_isomorphismD

lemma (in subcategory) subcat_the_inverse_simp[cat_sub_bw_cs_simps]:
  assumes "f : a ↦iso𝔅 b" 
  shows "fΒ―C𝔅 = fΒ―Cβ„­"
proof-
  from assms have "is_inverse 𝔅 (fΒ―C𝔅) f"
    by (auto dest: sdg.cat_the_inverse_is_inverse)
  with subcategory_axioms have inv_f𝔅: "is_inverse β„­ (fΒ―C𝔅) f" 
    by (auto dest: cat_sub_fw_cs_intros)
  from assms have "f : a ↦isoβ„­ b" by (auto dest: cat_sub_fw_cs_intros)
  then have inv_fβ„­: "is_inverse β„­ (fΒ―Cβ„­) f" 
    by (auto dest: dg.cat_the_inverse_is_inverse)
  from inv_f𝔅 inv_fβ„­ show ?thesis by (intro dg.cat_is_inverse_eq)
qed

lemmas [cat_sub_bw_cs_simps] = subcategory.subcat_the_inverse_simp

lemma (in subcategory) subcat_obj_isoD:
  assumes "a β‰ˆobj𝔅 b" 
  shows "a β‰ˆobjβ„­ b"
  using assms subcategory_axioms
  by (elim obj_isoE) 
    (
      cs_concl 
        cs_simp: cat_sub_bw_cs_simps cs_intro: obj_isoI cat_sub_fw_cs_intros
    )

lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_obj_isoD


subsubsectionβ€ΉSubcategory relation is a partial orderβ€Ί

lemma subcat_refl:
  assumes "category Ξ± 𝔄"
  shows "𝔄 βŠ†CΞ± 𝔄"
proof-
  interpret category Ξ± 𝔄 by (rule assms)
  show ?thesis 
    by (auto intro: cat_cs_intros slicing_intros subdg_refl subsemicategoryI)
qed

lemma subcat_trans: 
  assumes "𝔄 βŠ†CΞ± 𝔅" and "𝔅 βŠ†CΞ± β„­"
  shows "𝔄 βŠ†CΞ± β„­"
proof-
  interpret 𝔄𝔅: subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅ℭ: subcategory Ξ± 𝔅 β„­ by (rule assms(2))
  show ?thesis 
  proof(rule subcategoryI)
    show "cat_smc 𝔄 βŠ†SMCΞ± cat_smc β„­"
      by 
        (
          meson 
            𝔄𝔅.subcat_subsemicategory 
            𝔅ℭ.subcat_subsemicategory 
            subsmc_trans
        )
  qed 
    ( 
      use 𝔄𝔅.subcategory_axioms 𝔅ℭ.subcategory_axioms in 
        β€Ήauto simp: 𝔄𝔅.subcat_Obj_vsubset cat_sub_bw_cs_simpsβ€Ί
    )
qed

lemma subcat_antisym:
  assumes "𝔄 βŠ†CΞ± 𝔅" and "𝔅 βŠ†CΞ± 𝔄"
  shows "𝔄 = 𝔅"
proof-
  interpret 𝔄𝔅: subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅𝔄: subcategory Ξ± 𝔅 𝔄 by (rule assms(2))
  show ?thesis
  proof(rule cat_eqI)
    from 
      subsmc_antisym[
        OF 𝔄𝔅.subcat_subsemicategory 𝔅𝔄.subcat_subsemicategory
        ] 
    have 
      "cat_smc 𝔄⦇Obj⦈ = cat_smc 𝔅⦇Obj⦈" "cat_smc 𝔄⦇Arr⦈ = cat_smc 𝔅⦇Arr⦈"
      by simp_all
    then show Obj: "𝔄⦇Obj⦈ = 𝔅⦇Obj⦈" and Arr: "𝔄⦇Arr⦈ = 𝔅⦇Arr⦈" 
      unfolding slicing_simps by simp_all
    show "𝔄⦇Dom⦈ = 𝔅⦇Dom⦈"
      by (rule vsv_eqI) (auto simp: 𝔄𝔅.subcat_dom_simp Arr cat_cs_simps)
    show "𝔄⦇Cod⦈ = 𝔅⦇Cod⦈"
      by (rule vsv_eqI) (auto simp: 𝔅𝔄.subcat_cod_simp Arr cat_cs_simps)
    have "cat_smc 𝔄 βŠ†SMCΞ± cat_smc 𝔅" "cat_smc 𝔅 βŠ†SMCΞ± cat_smc 𝔄" 
      by (simp_all add: 𝔄𝔅.subcat_subsemicategory 𝔅𝔄.subcat_subsemicategory)
    from subsmc_antisym[OF this] have "cat_smc 𝔄 = cat_smc 𝔅" .
    then have "cat_smc 𝔄⦇Comp⦈ = cat_smc 𝔅⦇Comp⦈" by auto
    then show "𝔄⦇Comp⦈ = 𝔅⦇Comp⦈" unfolding slicing_simps by simp
    show "𝔄⦇CId⦈ = 𝔅⦇CId⦈"
      by (rule vsv_eqI) (auto simp: Obj 𝔄𝔅.subcat_CId_simp cat_cs_simps)
  qed (auto intro: cat_cs_intros)
qed



subsectionβ€ΉInclusion functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.β€Ί

abbreviation (input) cf_inc :: "V β‡’ V β‡’ V"
  where "cf_inc ≑ dghm_inc"


textβ€ΉSlicing.β€Ί

lemma dghm_smcf_inc[slicing_commute]: 
  "dghm_inc (cat_smc 𝔅) (cat_smc β„­) = cf_smcf (cf_inc 𝔅 β„­)"
  unfolding cf_smcf_def dghm_inc_def cat_smc_def dg_field_simps dghm_field_simps 
  by (simp_all add: nat_omega_simps)


textβ€ΉElementary properties.β€Ί

lemmas [cat_cs_simps] = 
  dghm_inc_ObjMap_app 
  dghm_inc_ArrMap_app


subsubsectionβ€ΉCanonical inclusion functor associated with a subcategoryβ€Ί

sublocale subcategory βŠ† inc: is_ft_functor Ξ± 𝔅 β„­ β€Ήcf_inc 𝔅 β„­β€Ί
proof(rule is_ft_functorI)
  interpret subsmc: subsemicategory Ξ± β€Ήcat_smc 𝔅› β€Ήcat_smc β„­β€Ί
    by (rule subcat_subsemicategory)
  show "cf_inc 𝔅 β„­ : 𝔅 ↦↦CΞ± β„­"  
  proof(rule is_functorI) 
    show "vfsequence (cf_inc 𝔅 β„­)" unfolding dghm_inc_def by auto
    show "vcard (cf_inc 𝔅 β„­) = 4β„•"
      unfolding dghm_inc_def by (simp add: nat_omega_simps)
    from sdg.cat_CId_is_arr subcat_CId_simp show "c ∈∘ 𝔅⦇Obj⦈ ⟹ 
      cf_inc 𝔅 ℭ⦇ArrMapβ¦ˆβ¦‡π”…β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡cf_inc 𝔅 ℭ⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      for c
      unfolding dghm_inc_components by force
    from subsmc.inc.is_ft_semifunctor_axioms show 
      "cf_smcf (cf_inc 𝔅 β„­) : cat_smc 𝔅 ↦↦SMCΞ± cat_smc β„­"
      unfolding slicing_commute by auto
  qed (auto simp: dghm_inc_components cat_cs_intros)
  from subsmc.inc.is_ft_semifunctor_axioms show 
    "cf_smcf (cf_inc 𝔅 β„­) : cat_smc 𝔅 ↦↦SMC.faithfulΞ± cat_smc β„­" 
    unfolding slicing_commute by auto
qed

lemmas (in subcategory) subcat_cf_inc_is_ft_functor = inc.is_ft_functor_axioms


subsubsectionβ€ΉInclusion functor for the opposite categoriesβ€Ί

lemma (in subcategory) subcat_cf_inc_op_cat_is_functor:
  "cf_inc (op_cat 𝔅) (op_cat β„­) : op_cat 𝔅 ↦↦C.faithfulΞ± op_cat β„­"
  by 
    (
      intro 
        subcategory.subcat_cf_inc_is_ft_functor
        subcat_subcategory_op_cat
    )
  
lemma (in subcategory) subcat_op_cat_cf_inc: 
  "cf_inc (op_cat 𝔅) (op_cat β„­) = op_cf (cf_inc 𝔅 β„­)"
  by (rule cf_eqI)
    (
      auto 
        simp: 
          cat_op_simps 
          dghm_inc_components
          subcat_cf_inc_op_cat_is_functor
          is_ft_functor.axioms(1) 
        intro: cat_op_intros 
    )



subsectionβ€ΉFull subcategoryβ€Ί


textβ€ΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.β€Ί

locale fl_subcategory = subcategory +
  assumes fl_subcat_fl_subsemicategory: "cat_smc 𝔅 βŠ†SMC.fullΞ± cat_smc β„­"

abbreviation is_fl_subcategory ("(_/ βŠ†C.fullΔ± _)" [51, 51] 50)
  where "𝔅 βŠ†C.fullΞ± β„­ ≑ fl_subcategory Ξ± 𝔅 β„­"


textβ€ΉRules.β€Ί

mk_ide rf fl_subcategory_def[unfolded fl_subcategory_axioms_def]
  |intro fl_subcategoryI|
  |dest fl_subcategoryD[dest]|
  |elim fl_subcategoryE[elim!]|

lemmas [cat_sub_cs_intros] = fl_subcategoryD(1)


textβ€ΉElementary properties.β€Ί

sublocale fl_subcategory βŠ† inc: is_fl_functor Ξ± 𝔅 β„­ β€Ήcf_inc 𝔅 β„­β€Ί
proof(rule is_fl_functorI)
  interpret fl_subsemicategory Ξ± β€Ήcat_smc 𝔅› β€Ήcat_smc β„­β€Ί
    by (rule fl_subcat_fl_subsemicategory)
  from inc.is_fl_semifunctor_axioms show 
    "cf_smcf (dghm_inc 𝔅 β„­) : cat_smc 𝔅 ↦↦SMC.fullΞ± cat_smc β„­"
    unfolding slicing_commute by simp
qed (rule inc.is_functor_axioms)



subsectionβ€ΉWide subcategoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
See 
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/wide+subcategory}
}.
β€Ί

locale wide_subcategory = subcategory +
  assumes wide_subcat_wide_subsemicategory: "cat_smc 𝔅 βŠ†SMC.wideΞ± cat_smc β„­"

abbreviation is_wide_subcategory ("(_/ βŠ†C.wideΔ± _)" [51, 51] 50)
  where "𝔅 βŠ†C.wideΞ± β„­ ≑ wide_subcategory Ξ± 𝔅 β„­"


textβ€ΉRules.β€Ί

mk_ide rf wide_subcategory_def[unfolded wide_subcategory_axioms_def]
  |intro wide_subcategoryI|
  |dest wide_subcategoryD[dest]|
  |elim wide_subcategoryE[elim!]|

lemmas [cat_sub_cs_intros] = wide_subcategoryD(1)


textβ€ΉWide subcategory is wide subsemicategory.β€Ί

context wide_subcategory
begin

interpretation wide_subsmc: wide_subsemicategory Ξ± β€Ήcat_smc 𝔅› β€Ήcat_smc β„­β€Ί
  by (rule wide_subcat_wide_subsemicategory)

lemmas_with [unfolded slicing_simps]:
  wide_subcat_Obj[dg_sub_bw_cs_intros] = wide_subsmc.wide_subsmc_Obj
  and wide_subcat_obj_eq[dg_sub_bw_cs_simps] = wide_subsmc.wide_subsmc_obj_eq

end

lemmas [cat_sub_bw_cs_simps] =  wide_subcategory.wide_subcat_obj_eq[symmetric]
lemmas [cat_sub_bw_cs_simps] = wide_subsemicategory.wide_subsmc_obj_eq


subsubsectionβ€ΉThe wide subcategory relation is a partial orderβ€Ί

lemma wide_subcat_refl: 
  assumes "category Ξ± 𝔄" 
  shows "𝔄 βŠ†C.wideΞ± 𝔄"
proof-
  interpret category Ξ± 𝔄 by (rule assms)
  show ?thesis
    by
      (
        auto intro: 
          assms
          slicing_intros 
          wide_subsmc_refl 
          wide_subcategoryI 
          subsmc_refl 
      )
qed

lemma wide_subcat_trans[trans]:
  assumes "𝔄 βŠ†C.wideΞ± 𝔅" and "𝔅 βŠ†C.wideΞ± β„­"
  shows "𝔄 βŠ†C.wideΞ± β„­"
proof-
  interpret 𝔄𝔅: wide_subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅ℭ: wide_subcategory Ξ± 𝔅 β„­ by (rule assms(2))
  show ?thesis
    by 
      (
        intro 
          wide_subcategoryI 
          subcat_trans[OF 𝔄𝔅.subcategory_axioms 𝔅ℭ.subcategory_axioms], 
        rule wide_subsmc_trans, 
        rule 𝔄𝔅.wide_subcat_wide_subsemicategory, 
        rule 𝔅ℭ.wide_subcat_wide_subsemicategory
     )
qed

lemma wide_subcat_antisym:
  assumes "𝔄 βŠ†C.wideΞ± 𝔅" and "𝔅 βŠ†C.wideΞ± 𝔄"
  shows "𝔄 = 𝔅"
proof-
  interpret 𝔄𝔅: wide_subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅𝔄: wide_subcategory Ξ± 𝔅 𝔄 by (rule assms(2))
  show ?thesis 
    by (rule subcat_antisym[OF 𝔄𝔅.subcategory_axioms 𝔅𝔄.subcategory_axioms])
qed



subsectionβ€ΉReplete subcategoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

textβ€Ή
See nLab
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/replete+subcategory}
}.
β€Ί

locale replete_subcategory = subcategory Ξ± 𝔅 β„­ for Ξ± 𝔅 β„­ +
  assumes rep_subcat_is_arr_isomorphism_is_arr: 
    "a ∈∘ 𝔅⦇Obj⦈ ⟹ f : a ↦isoβ„­ b ⟹ f : a ↦𝔅 b"

abbreviation is_replete_subcategory ("(_/ βŠ†C.repΔ± _)" [51, 51] 50)
  where "𝔅 βŠ†C.repΞ± β„­ ≑ replete_subcategory Ξ± 𝔅 β„­"


textβ€ΉRules.β€Ί

mk_ide rf replete_subcategory_def[unfolded replete_subcategory_axioms_def]
  |intro replete_subcategoryI|
  |dest replete_subcategoryD[dest]|
  |elim replete_subcategoryE[elim!]|

lemmas [cat_sub_cs_intros] = replete_subcategoryD(1)


textβ€ΉElementary properties.β€Ί

lemma (in replete_subcategory) (*not cat_sub_intro*)
  rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left:
  assumes "a ∈∘ 𝔅⦇Obj⦈" and "f : a ↦isoβ„­ b"
  shows "f : a ↦iso𝔅 b"
proof(intro is_arr_isomorphismI is_inverseI)
  from assms show f: "f : a ↦𝔅 b" 
    by (auto intro: rep_subcat_is_arr_isomorphism_is_arr)
  have "fΒ―Cβ„­ : b ↦isoβ„­ a"
    by (rule dg.cat_the_inverse_is_arr_isomorphism[OF assms(2)])
  with f show inv_f: "fΒ―Cβ„­ : b ↦𝔅 a" 
    by (auto intro: rep_subcat_is_arr_isomorphism_is_arr)
  show "f : a ↦𝔅 b" by (rule f)
  from dg.category_axioms assms have [cat_sub_bw_cs_simps]: 
    "fΒ―Cβ„­ ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from dg.category_axioms assms have [cat_sub_bw_cs_simps]: 
    "f ∘Aβ„­ fΒ―Cβ„­ = ℭ⦇CIdβ¦ˆβ¦‡b⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from subcategory_axioms f inv_f show "fΒ―Cβ„­ ∘A𝔅 f = 𝔅⦇CIdβ¦ˆβ¦‡a⦈"
    by (cs_concl cs_simp: cat_sub_bw_cs_simps cs_intro: cat_cs_intros)
  from subcategory_axioms f inv_f show "f ∘A𝔅 fΒ―Cβ„­ = 𝔅⦇CIdβ¦ˆβ¦‡b⦈"
    by (cs_concl cs_simp: cat_sub_bw_cs_simps cs_intro: cat_cs_intros)
qed

lemma (in replete_subcategory) (*not cat_sub_intro*)
  rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "f : a ↦isoβ„­ b"
  shows "f : a ↦iso𝔅 b"
proof-
  from assms(2) have "fΒ―Cβ„­ : b ↦isoβ„­ a"
    by (rule dg.cat_the_inverse_is_arr_isomorphism)
  with assms(1) have inv_f: "fΒ―Cβ„­ : b ↦iso𝔅 a"
    by (intro rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left)
  then have "(fΒ―Cβ„­)Β―C𝔅 : a ↦iso𝔅 b" 
    by (rule sdg.cat_the_inverse_is_arr_isomorphism)
  moreover from replete_subcategory_axioms assms inv_f have "(fΒ―Cβ„­)Β―C𝔅 = f"
    by 
      (
        cs_concl 
          cs_simp: cat_sub_bw_cs_simps cat_cs_simps cs_intro: cat_cs_intros 
      )
  ultimately show ?thesis by simp
qed

lemma (in replete_subcategory) (*not cat_sub_bw_cs_simps*)
  rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left_iff:
  assumes "a ∈∘ 𝔅⦇Obj⦈" 
  shows "f : a ↦iso𝔅 b ⟷ f : a ↦isoβ„­ b"
  using assms replete_subcategory_axioms 
  by (intro iffI)
    (
      cs_concl cs_intro: 
        rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left 
        cat_sub_fw_cs_intros
    )

lemma (in replete_subcategory) (*not cat_sub_bw_cs_simps*)
  rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right_iff:
  assumes "b ∈∘ 𝔅⦇Obj⦈" 
  shows "f : a ↦iso𝔅 b ⟷ f : a ↦isoβ„­ b"
  using assms replete_subcategory_axioms 
  by (intro iffI)
    (
      cs_concl cs_intro: 
        rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right
        cat_sub_fw_cs_intros
    )


subsubsectionβ€ΉThe replete subcategory relation is a partial orderβ€Ί

lemma rep_subcat_refl: 
  assumes "category Ξ± 𝔄" 
  shows "𝔄 βŠ†C.repΞ± 𝔄"
proof-
  interpret category Ξ± 𝔄 by (rule assms)
  show ?thesis 
    by (intro replete_subcategoryI subcat_refl assms is_arr_isomorphismD(1))
qed

lemma rep_subcat_trans[trans]:
  assumes "𝔄 βŠ†C.repΞ± 𝔅" and "𝔅 βŠ†C.repΞ± β„­"
  shows "𝔄 βŠ†C.repΞ± β„­"
proof-
  interpret 𝔄𝔅: replete_subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅ℭ: replete_subcategory Ξ± 𝔅 β„­ by (rule assms(2))
  show ?thesis
  proof
    (
      intro 
        replete_subcategoryI 
        subcat_trans[OF 𝔄𝔅.subcategory_axioms 𝔅ℭ.subcategory_axioms]
    )
    fix a b f assume prems: "a ∈∘ 𝔄⦇Obj⦈" "f : a ↦isoβ„­ b"
    have "b ∈∘ 𝔅⦇Obj⦈"
      by 
        (
          rule 𝔄𝔅.dg.cat_is_arrD(3)
            [
              OF 𝔅ℭ.rep_subcat_is_arr_isomorphism_is_arr[
                OF 𝔄𝔅.subcat_objD[OF prems(1)] prems(2)
                ]
            ]
        )
    then have "f : a ↦iso𝔅 b"
      by 
        (
          rule 𝔅ℭ.rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right[
            OF _ prems(2)
            ]
        )
    then show "f : a ↦𝔄 b"
      by (rule 𝔄𝔅.rep_subcat_is_arr_isomorphism_is_arr[OF prems(1)])
  qed
qed

lemma rep_subcat_antisym:
  assumes "𝔄 βŠ†C.repΞ± 𝔅" and "𝔅 βŠ†C.repΞ± 𝔄"
  shows "𝔄 = 𝔅"
proof-
  interpret 𝔄𝔅: replete_subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅𝔄: replete_subcategory Ξ± 𝔅 𝔄 by (rule assms(2))
  show ?thesis 
    by (rule subcat_antisym[OF 𝔄𝔅.subcategory_axioms 𝔅𝔄.subcategory_axioms])
qed



subsectionβ€ΉWide replete subcategoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale wide_replete_subcategory = 
  wide_subcategory Ξ± 𝔅 β„­ + replete_subcategory Ξ± 𝔅 β„­ for Ξ± 𝔅 β„­

abbreviation is_wide_replete_subcategory ("(_/ βŠ†C.wrΔ± _)" [51, 51] 50)
  where "𝔅 βŠ†C.wrΞ± β„­ ≑ wide_replete_subcategory Ξ± 𝔅 β„­"


textβ€ΉRules.β€Ί

mk_ide rf wide_replete_subcategory_def
  |intro wide_replete_subcategoryI|
  |dest wide_replete_subcategoryD[dest]|
  |elim wide_replete_subcategoryE[elim!]|

lemmas [cat_sub_cs_intros] = wide_replete_subcategoryD


textβ€ΉWide replete subcategory preserves isomorphisms.β€Ί

lemma (in wide_replete_subcategory) 
  wr_subcat_is_arr_isomorphism_is_arr_isomorphism:
  "f : a ↦iso𝔅 b ⟷ f : a ↦isoβ„­ b"
proof(rule iffI)
  assume prems: "f : a ↦isoβ„­ b"
  then have "a ∈∘ ℭ⦇Obj⦈" by auto
  then have a: "a ∈∘ 𝔅⦇Obj⦈" by (simp add: wide_subcat_obj_eq)
  show "f : a ↦iso𝔅 b"
    by (intro rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left[OF a prems])
qed 
  (
    use wide_replete_subcategory_axioms in
      β€Ήcs_concl cs_intro: cat_sub_fw_cs_intros β€Ί
  )

lemmas [cat_sub_bw_cs_simps] = 
  wide_replete_subcategory.wr_subcat_is_arr_isomorphism_is_arr_isomorphism


subsubsectionβ€ΉThe wide replete subcategory relation is a partial orderβ€Ί

lemma wr_subcat_refl: 
  assumes "category Ξ± 𝔄" 
  shows "𝔄 βŠ†C.wrΞ± 𝔄"
  by (intro wide_replete_subcategoryI wide_subcat_refl rep_subcat_refl assms)

lemma wr_subcat_trans[trans]:
  assumes "𝔄 βŠ†C.wrΞ± 𝔅" and "𝔅 βŠ†C.wrΞ± β„­"
  shows "𝔄 βŠ†C.wrΞ± β„­"
proof-
  interpret 𝔄𝔅: wide_replete_subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅ℭ: wide_replete_subcategory Ξ± 𝔅 β„­ by (rule assms(2))
  show ?thesis
    by 
      (
        intro wide_replete_subcategoryI,
        rule wide_subcat_trans, 
        rule 𝔄𝔅.wide_subcategory_axioms,
        rule 𝔅ℭ.wide_subcategory_axioms,
        rule rep_subcat_trans,
        rule 𝔄𝔅.replete_subcategory_axioms,
        rule 𝔅ℭ.replete_subcategory_axioms
      )
qed

lemma wr_subcat_antisym:
  assumes "𝔄 βŠ†C.wrΞ±  𝔅" and "𝔅 βŠ†C.wrΞ±  𝔄"
  shows "𝔄 = 𝔅"
proof-
  interpret 𝔄𝔅: wide_replete_subcategory Ξ± 𝔄 𝔅 by (rule assms(1))
  interpret 𝔅𝔄: wide_replete_subcategory Ξ± 𝔅 𝔄 by (rule assms(2))
  show ?thesis 
    by (rule subcat_antisym[OF 𝔄𝔅.subcategory_axioms 𝔅𝔄.subcategory_axioms])
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Simple

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉSimple categoriesβ€Ί
theory CZH_ECAT_Simple
  imports 
    CZH_Foundations.CZH_SMC_Simple
    CZH_ECAT_Functor
    CZH_ECAT_Small_Functor
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The section presents a variety of simple categories, 
(such as the empty category β€Ή0β€Ί and the singleton category β€Ή1β€Ί)
and functors between them (see \cite{mac_lane_categories_2010}
for further information).
β€Ί



subsectionβ€ΉEmpty category β€Ή0β€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.β€Ί

definition cat_0 :: "V"
  where "cat_0 = [0, 0, 0, 0, 0, 0]∘"


textβ€ΉComponents.β€Ί

lemma cat_0_components:
  shows "cat_0⦇Obj⦈ = 0"
    and "cat_0⦇Arr⦈ = 0"
    and "cat_0⦇Dom⦈ = 0"
    and "cat_0⦇Cod⦈ = 0"
    and "cat_0⦇Comp⦈ = 0"
    and "cat_0⦇CId⦈ = 0"
  unfolding cat_0_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma smc_cat_0: "cat_smc cat_0 = smc_0"
  unfolding cat_smc_def cat_0_def smc_0_def dg_field_simps
  by (simp add: nat_omega_simps)

lemmas_with (in 𝒡) [folded smc_cat_0, unfolded slicing_simps]: 
  cat_0_is_arr_iff = smc_0_is_arr_iff


subsubsectionβ€Ήβ€Ή0β€Ί is a categoryβ€Ί

lemma (in 𝒡) category_cat_0: "category Ξ± cat_0"
proof(intro categoryI)
  show "vfsequence cat_0" "vcard cat_0 = 6β„•" 
    by (simp_all add: cat_0_def nat_omega_simps)
qed 
  (
    auto simp: 
      cat_0_components 𝒡_axioms cat_0_is_arr_iff smc_cat_0 𝒡.semicategory_smc_0
  )



subsectionβ€ΉEmpty functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_0 :: "V β‡’ V"
  where "cf_0 𝔄 = [0, 0, cat_0, 𝔄]∘"


textβ€ΉComponents.β€Ί

lemma cf_0_components:
  shows "cf_0 𝔄⦇ObjMap⦈ = 0"
    and "cf_0 𝔄⦇ArrMap⦈ = 0"
    and "cf_0 𝔄⦇HomDom⦈ = cat_0"
    and "cf_0 𝔄⦇HomCod⦈ = 𝔄"
  unfolding cf_0_def dghm_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cf_smcf_cf_0: "cf_smcf (cf_0 𝔄) = smcf_0 (cat_smc 𝔄)"
  unfolding 
    dg_field_simps dghm_field_simps 
    cf_smcf_def cf_0_def smc_0_def cat_0_def smcf_0_def cat_smc_def 
  by (simp add: nat_omega_simps)


subsubsectionβ€ΉEmpty functor is a faithful functorβ€Ί

lemma (in 𝒡) cf_0_is_functor: 
  assumes "category Ξ± 𝔄"
  shows "cf_0 𝔄 : cat_0 ↦↦C.faithfulΞ± 𝔄"
proof(rule is_ft_functorI)
  show "cf_0 𝔄 : cat_0 ↦↦CΞ± 𝔄"
  proof(rule is_functorI, unfold smc_cat_0 cf_smcf_cf_0)
    show "vfsequence (cf_0 𝔄)" unfolding cf_0_def by simp
    show "vcard (cf_0 𝔄) = 4β„•"
      unfolding cf_0_def by (simp add: nat_omega_simps)
    from 𝒡.smcf_0_is_semifunctor assms show 
      "smcf_0 (cat_smc 𝔄) : smc_0 ↦↦SMCΞ± cat_smc 𝔄"   
      by auto
  qed (auto simp: assms category_cat_0 cat_0_components cf_0_components)
  show "cf_smcf (cf_0 𝔄) : cat_smc cat_0 ↦↦SMC.faithfulΞ± cat_smc 𝔄"
    by 
      (
        auto simp:
          assms 
          𝒡_axioms
          𝒡.smcf_0_is_semifunctor  
          category.cat_semicategory 
          cf_smcf_cf_0 
          smc_cat_0
      )
qed



subsectionβ€Ήβ€Ή1β€Ί: category with one object and one arrowβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.β€Ί

definition cat_1 :: "V β‡’ V β‡’ V"
  where "cat_1 π”ž 𝔣 =
    [
      set {π”ž},
      set {𝔣},
      set {βŸ¨π”£, π”žβŸ©},
      set {βŸ¨π”£, π”žβŸ©},
      set {⟨[𝔣, 𝔣]∘, π”£βŸ©},
      set {βŸ¨π”ž, π”£βŸ©}
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_1_components:
  shows "cat_1 π”ž 𝔣⦇Obj⦈ = set {π”ž}"
    and "cat_1 π”ž 𝔣⦇Arr⦈ = set {𝔣}"
    and "cat_1 π”ž 𝔣⦇Dom⦈ = set {βŸ¨π”£, π”žβŸ©}"
    and "cat_1 π”ž 𝔣⦇Cod⦈ = set {βŸ¨π”£, π”žβŸ©}"
    and "cat_1 π”ž 𝔣⦇Comp⦈ = set {⟨[𝔣, 𝔣]∘, π”£βŸ©}"
    and "cat_1 π”ž 𝔣⦇CId⦈ = set {βŸ¨π”ž, π”£βŸ©}"
  unfolding cat_1_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma smc_cat_1: "cat_smc (cat_1 π”ž 𝔣) = smc_1 π”ž 𝔣"
  unfolding cat_smc_def cat_1_def smc_1_def dg_field_simps
  by (simp add: nat_omega_simps)

lemmas_with (in 𝒡) [folded smc_cat_1, unfolded slicing_simps]: 
  cat_1_is_arrI = smc_1_is_arrI
  and cat_1_is_arrD = smc_1_is_arrD
  and cat_1_is_arrE = smc_1_is_arrE
  and cat_1_is_arr_iff = smc_1_is_arr_iff
  and cat_1_Comp_app[cat_cs_simps] = smc_1_Comp_app


subsubsectionβ€ΉObjectβ€Ί

lemma cat_1_ObjI[cat_cs_intros]:
  assumes "a = π”ž"
  shows "a ∈∘ cat_1 π”ž 𝔣 ⦇Obj⦈"
  unfolding cat_1_components(1) assms by simp


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_1_CId_app: "cat_1 π”ž 𝔣⦇CIdβ¦ˆβ¦‡π”žβ¦ˆ = 𝔣" 
  unfolding cat_1_components by simp


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma cat_1_is_arrI:
  assumes "f = 𝔣" and "a = π”ž" and "b = π”ž"
  shows "f : a ↦cat_1 π”ž 𝔣 b"
  by (rule is_arrI, unfold assms cat_1_components) auto


subsubsectionβ€Ήβ€Ή1β€Ί is a categoryβ€Ί

lemma (in 𝒡) category_cat_1: 
  assumes "π”ž ∈∘ Vset Ξ±" and "𝔣 ∈∘ Vset Ξ±" 
  shows "category Ξ± (cat_1 π”ž 𝔣)"
proof(intro categoryI, unfold smc_cat_1)
  show "vfsequence (cat_1 π”ž 𝔣)"
    unfolding cat_1_def by (simp add: nat_omega_simps)
  show "vcard (cat_1 π”ž 𝔣) = 6β„•"
    unfolding cat_1_def by (simp add: nat_omega_simps)
qed (auto simp: assms semicategory_smc_1 cat_1_is_arr_iff cat_1_components)

lemmas [cat_cs_intros] = 𝒡.category_cat_1

lemma (in 𝒡) finite_category_cat_1: 
  assumes "π”ž ∈∘ Vset Ξ±" and "𝔣 ∈∘ Vset Ξ±" 
  shows "finite_category Ξ± (cat_1 π”ž 𝔣)"
  by (intro finite_categoryI')
    (auto simp: cat_1_components intro: category_cat_1[OF assms])

lemmas [cat_small_cs_intros] = 𝒡.finite_category_cat_1


subsubsectionβ€ΉOpposite of the category β€Ή1β€Ίβ€Ί

lemma (in 𝒡) cat_1_op[cat_op_simps]:
  assumes "π”ž ∈∘ Vset Ξ±" and "𝔣 ∈∘ Vset Ξ±"
  shows "op_cat (cat_1 π”ž 𝔣) = cat_1 π”ž 𝔣"
proof(rule cat_eqI, unfold cat_op_simps)
  from assms show "category Ξ± (op_cat (cat_1 π”ž 𝔣))"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  from assms show "category Ξ± (cat_1 π”ž 𝔣)"
    by (cs_concl cs_intro: cat_cs_intros)
  show "op_cat (cat_1 π”ž 𝔣)⦇Comp⦈ = cat_1 π”ž 𝔣⦇Comp⦈"
    unfolding cat_1_components op_cat_components fflip_vsingleton ..
qed (simp_all add: cat_1_components)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma cf_const_if_HomCod_is_cat_1:
  assumes "π”Ž : 𝔅 ↦↦CΞ± cat_1 π”ž 𝔣"
  shows "π”Ž = cf_const 𝔅 (cat_1 π”ž 𝔣) π”ž"
proof(rule cf_eqI)
  interpret π”Ž: is_functor Ξ± 𝔅 β€Ήcat_1 π”ž 𝔣› π”Ž by (rule assms(1))
  show "cf_const 𝔅 (cat_1 π”ž 𝔣) π”ž : 𝔅 ↦↦CΞ± cat_1 π”ž 𝔣"
    by (cs_concl cs_intro: cat_cs_intros)
  have ObjMap_dom_lhs: "π’Ÿβˆ˜ (π”Žβ¦‡ObjMap⦈) = 𝔅⦇Obj⦈" by (simp add: cat_cs_simps)
  have ObjMap_dom_rhs: "π’Ÿβˆ˜ (cf_const 𝔅 (cat_1 π”ž 𝔣) π”žβ¦‡ObjMap⦈) = 𝔅⦇Obj⦈"
    by (simp add: cat_cs_simps)
  have ArrMap_dom_lhs: "π’Ÿβˆ˜ (π”Žβ¦‡ArrMap⦈) = 𝔅⦇Arr⦈" by (simp add: cat_cs_simps)
  have ArrMap_dom_rhs: "π’Ÿβˆ˜ (cf_const 𝔅 (cat_1 π”ž 𝔣) π”žβ¦‡ArrMap⦈) = 𝔅⦇Arr⦈"
    by (simp add: cat_cs_simps)
  show "π”Žβ¦‡ObjMap⦈ = cf_const 𝔅 (cat_1 π”ž 𝔣) π”žβ¦‡ObjMap⦈"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix a assume prems: "a ∈∘ 𝔅⦇Obj⦈"
    then have "π”Žβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ∈∘ cat_1 π”ž 𝔣⦇Obj⦈"
      by (auto intro: π”Ž.cf_ObjMap_app_in_HomCod_Obj)
    then have "π”Žβ¦‡ObjMapβ¦ˆβ¦‡a⦈ = π”ž" by (auto simp: cat_1_components)
    with prems show "π”Žβ¦‡ObjMapβ¦ˆβ¦‡a⦈ = cf_const 𝔅 (cat_1 π”ž 𝔣) π”žβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
      by (auto simp: cat_cs_simps)
  qed (auto intro: cat_cs_intros)
  show "π”Žβ¦‡ArrMap⦈ = cf_const 𝔅 (cat_1 π”ž 𝔣) π”žβ¦‡ArrMap⦈"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix a assume prems: "a ∈∘ 𝔅⦇Arr⦈"
    then have "π”Žβ¦‡ArrMapβ¦ˆβ¦‡a⦈ ∈∘ cat_1 π”ž 𝔣⦇Arr⦈"
      by (auto intro: π”Ž.cf_ArrMap_app_in_HomCod_Arr)
    then have "π”Žβ¦‡ArrMapβ¦ˆβ¦‡a⦈ = 𝔣" by (auto simp: cat_1_components)
    with prems show "π”Žβ¦‡ArrMapβ¦ˆβ¦‡a⦈ = cf_const 𝔅 (cat_1 π”ž 𝔣) π”žβ¦‡ArrMapβ¦ˆβ¦‡a⦈"
      by (auto simp: cat_1_CId_app cat_cs_simps)
  qed (auto intro: cat_cs_intros)
qed (simp_all add: assms)

lemma cf_const_if_HomDom_is_cat_1:
  assumes "π”Ž : cat_1 π”ž 𝔣 ↦↦CΞ± β„­"
  shows "π”Ž = cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)"
proof-

  interpret π”Ž: is_functor Ξ± β€Ήcat_1 π”ž 𝔣› β„­ π”Ž by (rule assms(1))

  from cat_1_components(1) have π”ž: "π”ž ∈∘ Vset Ξ±" 
    by (auto simp: π”Ž.HomDom.cat_in_Obj_in_Vset)
  from cat_1_components(2) have 𝔣: "𝔣 ∈∘ Vset Ξ±" 
    by (auto simp: π”Ž.HomDom.cat_in_Arr_in_Vset)

  from π”ž 𝔣 interpret cf_1: 
    is_tm_functor Ξ± β€Ήcat_1 π”ž 𝔣› β„­ β€Ήcf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)β€Ί
    by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
  
  show ?thesis
  proof(rule cf_eqI)
    show "cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ) : cat_1 π”ž 𝔣 ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_cs_intros)
    have ObjMap_dom_lhs: "π’Ÿβˆ˜ (π”Žβ¦‡ObjMap⦈) = set {π”ž}" 
      by (simp add: cat_cs_simps cat_1_components)
    have ObjMap_dom_rhs: 
      "π’Ÿβˆ˜ (cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ObjMap⦈) = set {π”ž}"
      by (simp add: cat_cs_simps cat_1_components)
    show "π”Žβ¦‡ObjMap⦈ = cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix a assume "a ∈∘ set {π”ž}"
      then have a_def: "a = π”ž" by simp
      show "π”Žβ¦‡ObjMapβ¦ˆβ¦‡a⦈ = cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ObjMapβ¦ˆβ¦‡a⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_1_components(1) cat_cs_simps a_def 
              cs_intro: V_cs_intros
          )
    qed auto

    have ArrMap_dom_lhs: "π’Ÿβˆ˜ (π”Žβ¦‡ArrMap⦈) = set {𝔣}" 
      by (simp add: cat_cs_simps cat_1_components)
    have ArrMap_dom_rhs: 
      "π’Ÿβˆ˜ (cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ArrMap⦈) = set {𝔣}"
      by (simp add: cat_cs_simps cat_1_components)
    
    show "π”Žβ¦‡ArrMap⦈ = cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix f assume "f ∈∘ set {𝔣}"
      then have f_def: "f = 𝔣" by simp
      show "π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ = cf_const (cat_1 π”ž 𝔣) β„­ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)⦇ArrMapβ¦ˆβ¦‡f⦈"
        unfolding f_def
        by (subst cat_1_CId_app[symmetric, of 𝔣 π”ž])
          (
            cs_concl
              cs_simp: cat_1_components(1,2) cat_cs_simps 
              cs_intro: V_cs_intros cat_cs_intros
          )
    qed auto

  qed (simp_all add: assms)

qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Discrete

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉDiscrete categoryβ€Ί
theory CZH_ECAT_Discrete
  imports 
    CZH_ECAT_Simple
    CZH_ECAT_Small_Functor
begin



subsectionβ€ΉAbstract discrete categoryβ€Ί

named_theorems cat_discrete_cs_simps
named_theorems cat_discrete_cs_intros


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.β€Ί

locale cat_discrete = category Ξ± β„­ for Ξ± β„­ +
  assumes cat_discrete_Arr: "f ∈∘ ℭ⦇Arr⦈ ⟹ f ∈∘ β„›βˆ˜ (ℭ⦇CId⦈)"


textβ€ΉRules.β€Ί

lemma (in cat_discrete)
  assumes "Ξ±' = Ξ±" "β„­' = β„­"
  shows "cat_discrete Ξ±' β„­'"
  unfolding assms by (rule cat_discrete_axioms)

mk_ide rf cat_discrete_def[unfolded cat_discrete_axioms_def]
  |intro cat_discreteI|
  |dest cat_discreteD[dest]|
  |elim cat_discreteE[elim]|

lemmas [cat_discrete_cs_intros] = cat_discreteD(1)


textβ€ΉElementary properties.β€Ί

lemma (in cat_discrete) cat_discrete_is_arrD[dest]:
  assumes "f : a ↦ℭ b"
  shows "b = a" and "f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
proof-
  from assms cat_discrete_Arr have "f ∈∘ β„›βˆ˜ (ℭ⦇CId⦈)" 
    by (auto simp: cat_cs_simps)
  with cat_CId_vdomain obtain a' where f_def: "f = ℭ⦇CIdβ¦ˆβ¦‡a'⦈" and "a' ∈∘ ℭ⦇Obj⦈" 
    by (blast dest: CId.vrange_atD)
  then have "f : a' ↦ℭ a'" by (auto intro: cat_CId_is_arr')
  with assms have "a = a'" and "b = a'" by blast+
  with f_def show "b = a" and "f = ℭ⦇CIdβ¦ˆβ¦‡a⦈" by auto
qed

lemma (in cat_discrete) cat_discrete_is_arrE[elim]:
  assumes "f : b ↦ℭ c"
  obtains a where "f : a ↦ℭ a" and "f = ℭ⦇CIdβ¦ˆβ¦‡a⦈"
  using assms by auto



subsectionβ€ΉThe discrete categoryβ€Ί

textβ€Ή
As explained in Chapter I-2 in \cite{mac_lane_categories_2010}, every discrete
category is identified with its set of objects. 
In this work, it is assumed that the set of objects and the set of arrows
in the canonical discrete category coincide; the domain and the codomain 
functions are identities.
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition the_cat_discrete :: "V β‡’ V" (β€Ή:Cβ€Ί)
  where ":C I = [I, I, vid_on I, vid_on I, (Ξ»fg∈∘fid_on I. fg⦇0⦈), vid_on I]∘"


textβ€ΉComponents.β€Ί

lemma the_cat_discrete_components:
  shows ":C I⦇Obj⦈ = I"
    and ":C I⦇Arr⦈ = I"
    and ":C I⦇Dom⦈ = vid_on I"
    and ":C I⦇Cod⦈ = vid_on I"
    and ":C I⦇Comp⦈ = (Ξ»fg∈∘fid_on I. fg⦇0⦈)"
    and ":C I⦇CId⦈ = vid_on I"
  unfolding the_cat_discrete_def dg_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉDomainβ€Ί

mk_VLambda the_cat_discrete_components(3)[folded VLambda_vid_on]
  |vsv the_cat_discrete_Dom_vsv[cat_discrete_cs_intros]|
  |vdomain the_cat_discrete_Dom_vdomain[cat_discrete_cs_simps]|
  |app the_cat_discrete_Dom_app[cat_discrete_cs_simps]|


subsubsectionβ€ΉCodomainβ€Ί

mk_VLambda the_cat_discrete_components(4)[folded VLambda_vid_on]
  |vsv the_cat_discrete_Cod_vsv[cat_discrete_cs_intros]|
  |vdomain the_cat_discrete_Cod_vdomain[cat_discrete_cs_simps]|
  |app the_cat_discrete_Cod_app[cat_discrete_cs_simps]|


subsubsectionβ€ΉCompositionβ€Ί

lemma the_cat_discrete_Comp_vsv[cat_discrete_cs_intros]: "vsv (:C I⦇Comp⦈)"
  unfolding the_cat_discrete_components by simp

lemma the_cat_discrete_Comp_vdomain: "π’Ÿβˆ˜ (:C I⦇Comp⦈) = fid_on I"
  unfolding the_cat_discrete_components by simp

lemma the_cat_discrete_Comp_vrange: 
  "β„›βˆ˜ (:C I⦇Comp⦈) = I"
proof(intro vsubset_antisym vsubsetI)
  fix f assume "f ∈∘ β„›βˆ˜ (:C I⦇Comp⦈)"
  then obtain gg where f_def: "f = :C I⦇Compβ¦ˆβ¦‡gg⦈" and gg: "gg ∈∘ fid_on I"
    unfolding the_cat_discrete_components by auto
  from gg show "f ∈∘ I"
    unfolding f_def the_cat_discrete_components by clarsimp
next
  fix f assume "f ∈∘ I"
  then have "[f, f]∘ ∈∘ fid_on I" by clarsimp
  moreover then have "f = :C I⦇Compβ¦ˆβ¦‡f, fβ¦ˆβˆ™"
    unfolding the_cat_discrete_components by simp
  ultimately show "f ∈∘ β„›βˆ˜ (:C I⦇Comp⦈)"
    unfolding the_cat_discrete_components
    by (metis rel_VLambda.vsv_vimageI2 vdomain_VLambda)
qed
 
lemma the_cat_discrete_Comp_app[cat_discrete_cs_simps]: 
  assumes "i ∈∘ I"
  shows "i ∘A:C I i = i"
proof-
  from assms have "[i, i]∘ ∈∘ fid_on I" by clarsimp
  then show ?thesis unfolding the_cat_discrete_components by simp
qed


subsubsectionβ€ΉIdentityβ€Ί

mk_VLambda the_cat_discrete_components(6)[folded VLambda_vid_on]
  |vsv the_cat_discrete_CId_vsv[cat_discrete_cs_intros]|
  |vdomain the_cat_discrete_CId_vdomain[cat_discrete_cs_simps]|
  |app the_cat_discrete_CId_app[cat_discrete_cs_simps]|


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma the_cat_discrete_is_arrI:
  assumes "i ∈∘ I"
  shows "i : i ↦:C I i"
  using assms unfolding is_arr_def the_cat_discrete_components by simp

lemma the_cat_discrete_is_arrI'[cat_discrete_cs_intros]:
  assumes "i ∈∘ I"
    and "a = i"
    and "b = i"
  shows "i : a ↦:C I b"
  using assms(1) unfolding assms(2,3) by (rule the_cat_discrete_is_arrI)

lemma the_cat_discrete_is_arrD:
  assumes "f : a ↦:C I b"
  shows "f : f ↦:C I f"
    and "a : a ↦:C I a" 
    and "b : b ↦:C I b"
    and "f ∈∘ I"
    and "a ∈∘ I"
    and "b ∈∘ I"
    and "f = a"
    and "f = b"
    and "b = a"
  using assms unfolding is_arr_def the_cat_discrete_components by force+


subsubsectionβ€ΉThe discrete category is a discrete categoryβ€Ί

lemma (in 𝒡) cat_discrete_the_cat_discrete:
  assumes "I βŠ†βˆ˜ Vset Ξ±"
  shows "cat_discrete Ξ± (:C I)"
proof(intro cat_discreteI categoryI')
  show "vfsequence (:C I)" unfolding the_cat_discrete_def by simp
  show "vcard (:C I) = 6β„•"
    unfolding the_cat_discrete_def by (simp add: nat_omega_simps)
  show "gf ∈∘ π’Ÿβˆ˜ (:C I⦇Comp⦈) ⟷ 
    (βˆƒg f b c a. gf = [g, f]∘ ∧ g : b ↦:C I c ∧ f : a ↦:C I b)"
    for gf
    unfolding the_cat_discrete_Comp_vdomain
  proof
    assume "gf ∈∘ fid_on I"
    then obtain a where "gf = [a, a]∘" and "a ∈∘ I" by clarsimp
    moreover then have "a : a ↦:C I a" 
      by (auto intro: the_cat_discrete_is_arrI)
    ultimately show 
      "βˆƒg f b c a. gf = [g, f]∘ ∧ g : b ↦:C I c ∧ f : a ↦:C I b"
      by auto 
  next
    assume "βˆƒg f b c a. gf = [g, f]∘ ∧ g : b ↦:C I c ∧ f : a ↦:C I b"
    then obtain g f b c a where gf_def: "gf = [g, f]∘"  
      and g: "g : b ↦:C I c"
      and f: "f : a ↦:C I b"
      by clarsimp
    then have "g = f" by (metis is_arrE the_cat_discrete_is_arrD(1))
    with the_cat_discrete_is_arrD(4)[OF f] show "gf ∈∘ fid_on I"
      unfolding gf_def by clarsimp
  qed
  show "g ∘A:C I f : a ↦:C I c" if "g : b ↦:C I c" and "f : a ↦:C I b"
    for g b c f a
  proof-
    from that have fba: "f = a" "b = a" and a: "a ∈∘ I" 
      unfolding the_cat_discrete_is_arrD[OF that(2)] by (simp_all add: β€Ήa ∈∘ Iβ€Ί)
    from that have gcb: "g = b" "c = b"
      unfolding the_cat_discrete_is_arrD[OF that(1)] by simp_all
    from a show ?thesis
      unfolding fba gcb  
      by 
        (
          cs_concl 
            cs_simp: cat_discrete_cs_simps cs_intro: cat_discrete_cs_intros
        )
  qed
  show "h ∘A:C I g ∘A:C I f = h ∘A:C I (g ∘A:C I f)"
    if "h : c ↦:C I d" and "g : b ↦:C I c" and "f : a ↦:C I b"
    for h c d g b f a
  proof-
    from that have fba: "f = a" "b = a" and a: "a ∈∘ I" 
      unfolding the_cat_discrete_is_arrD[OF that(3)] by (simp_all add: β€Ήa ∈∘ Iβ€Ί)
    from that have gcb: "g = b" "c = b" 
      unfolding the_cat_discrete_is_arrD[OF that(2)] by simp_all
    from that have hcd: "h = c" "d = c"
      unfolding the_cat_discrete_is_arrD[OF that(1)] by simp_all
    from a show ?thesis
      unfolding fba gcb hcd by (cs_concl cs_simp: cat_discrete_cs_simps)
  qed
  show ":C I⦇CIdβ¦ˆβ¦‡b⦈ ∘A:C I f = f" if "f : a ↦:C I b" for f a b
  proof-
    from that have fba: "f = a" "b = a" and a: "a ∈∘ I" 
      unfolding the_cat_discrete_is_arrD[OF that] by (simp_all add: β€Ήa ∈∘ Iβ€Ί)
    from a show ?thesis 
      by (cs_concl cs_simp: cat_discrete_cs_simps fba)
  qed
  show "f ∘A:C I :C I⦇CIdβ¦ˆβ¦‡b⦈ = f" if "f : b ↦:C I c" for f b c
  proof-
    from that have fba: "f = b" "c = b" and b: "b ∈∘ I" 
      unfolding the_cat_discrete_is_arrD[OF that] by (simp_all add: β€Ήb ∈∘ Iβ€Ί)
    from b show ?thesis 
      by (cs_concl cs_simp: cat_discrete_cs_simps fba)
  qed
  show ":C I⦇CIdβ¦ˆβ¦‡a⦈ : a ↦:C I a"
    if "a ∈∘ :C I⦇Obj⦈" for a 
    using that 
    by (auto simp: the_cat_discrete_components intro: cat_discrete_cs_intros)
  show "β‹ƒβˆ˜((Ξ»a∈∘A. β‹ƒβˆ˜(VLambda B (Hom (:C I) a) `∘ B)) `∘ A) ∈∘ Vset Ξ±"
    if "A βŠ†βˆ˜ :C I⦇Obj⦈"
      and "B βŠ†βˆ˜ :C I⦇Obj⦈"
      and "A ∈∘ Vset α"
      and "B ∈∘ Vset α"
    for A B
  proof-
    have "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (:C I) a b) βŠ†βˆ˜ A βˆͺ∘ B"
    proof(intro vsubsetI, elim vifunionE, unfold in_Hom_iff)
      fix i j f assume prems: "i ∈∘ A" "j ∈∘ B" "f : i ↦:C I j"
      then show "f ∈∘ A βˆͺ∘ B" 
        unfolding the_cat_discrete_is_arrD[OF prems(3)] by simp
    qed
    moreover have "A βˆͺ∘ B ∈∘ Vset Ξ±" by (simp add: that(3,4) vunion_in_VsetI)
    ultimately show "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (:C I) a b) ∈∘ Vset Ξ±"
      by (auto simp: vsubset_in_VsetI)
  qed
qed (auto simp: assms the_cat_discrete_components intro: cat_cs_intros)

lemmas [cat_discrete_cs_intros] = 𝒡.cat_discrete_the_cat_discrete


subsubsectionβ€ΉOpposite discrete categoryβ€Ί

lemma (in 𝒡) the_cat_discrete_op[cat_op_simps]:
  assumes "I βŠ†βˆ˜ Vset Ξ±"
  shows "op_cat (:C I) = :C I"
proof(rule cat_eqI[of Ξ±])
  from assms show dI: "category Ξ± (:C I)"
    by (cs_concl cs_intro: cat_discrete_the_cat_discrete cat_discrete_cs_intros)
  then show op_dI: "category Ξ± (op_cat (:C I))"
    by (cs_concl cs_intro: cat_op_intros)
  interpret category Ξ± β€Ήop_cat (:C I)β€Ί by (rule op_dI)
  show "op_cat (:C I)⦇Comp⦈ = :C I⦇Comp⦈"
  proof(rule vsv_eqI)
    show "π’Ÿβˆ˜ (op_cat (:C I)⦇Comp⦈) = π’Ÿβˆ˜ (:C I⦇Comp⦈)"
      by (simp add: the_cat_discrete_components op_cat_components)
    fix gf assume "gf ∈∘ π’Ÿβˆ˜ (op_cat (:C I)⦇Comp⦈)"
    then have "gf ∈∘ fid_on I" 
      by (simp add: the_cat_discrete_components op_cat_components)
    then obtain h where gf_def: "gf = [h, h]∘" and h: "h ∈∘ I" by clarsimp
    from dI h show "op_cat (:C I)⦇Compβ¦ˆβ¦‡gf⦈ = :C I⦇Compβ¦ˆβ¦‡gf⦈" 
      by 
        ( 
          cs_concl 
            cs_simp: cat_op_simps gf_def cs_intro: cat_discrete_cs_intros
        )
  qed (auto intro: cat_discrete_cs_intros)
qed (unfold the_cat_discrete_components op_cat_components, simp_all)



subsectionβ€ΉDiscrete functorβ€Ί


subsubsectionβ€ΉLocal assumptions for the discrete functorβ€Ί


textβ€ΉSee Chapter III in \cite{mac_lane_categories_2010}).β€Ί

locale cf_discrete = category Ξ± β„­ for Ξ± I F β„­ +
  assumes cf_discrete_selector_vrange[cat_discrete_cs_intros]: 
    "i ∈∘ I ⟹ F i ∈∘ ℭ⦇Obj⦈"
    and cf_discrete_vdomain_vsubset_Vset: "I βŠ†βˆ˜ Vset Ξ±"

lemmas (in cf_discrete) cf_discrete_category = category_axioms

lemmas [cat_discrete_cs_intros] = cf_discrete.cf_discrete_category


textβ€ΉRules.β€Ί

lemma (in cf_discrete) cf_discrete_axioms'[cat_discrete_cs_intros]:
  assumes "Ξ±' = Ξ±" and "I' = I" and "F' = F" 
  shows "cf_discrete Ξ±' I' F' β„­"
  unfolding assms by (rule cf_discrete_axioms)

mk_ide rf cf_discrete_def[unfolded cf_discrete_axioms_def]
  |intro cf_discreteI|
  |dest cf_discreteD[dest]|
  |elim cf_discreteE[elim]|


textβ€ΉElementary properties.β€Ί

lemma (in cf_discrete) cf_discrete_is_functor_cf_CId_selector_is_arr: 
  assumes "i ∈∘ I"
  shows "ℭ⦇CIdβ¦ˆβ¦‡F i⦈ : F i ↦ℭ F i"
  using assms by (meson cat_CId_is_arr' cf_discreteD(2) cf_discrete_axioms)

lemma (in cf_discrete) 
  cf_discrete_is_functor_cf_CId_selector_is_arr'[cat_discrete_cs_intros]: 
  assumes "i ∈∘ I" and "a = F i" and "b = F i"
  shows "ℭ⦇CIdβ¦ˆβ¦‡F i⦈ : a ↦ℭ b"
  using assms(1)
  unfolding assms(2,3) 
  by (rule cf_discrete_is_functor_cf_CId_selector_is_arr)


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition the_cf_discrete :: "V β‡’ (V β‡’ V) β‡’ V β‡’ V" (β€Ή:β†’:β€Ί)
  where ":β†’: I F β„­ = [VLambda I F, (Ξ»i∈∘I. ℭ⦇CIdβ¦ˆβ¦‡F i⦈), :C I, β„­]∘"


textβ€ΉComponents.β€Ί

lemma the_cf_discrete_components:
  shows ":β†’: I F ℭ⦇ObjMap⦈ = (Ξ»i∈∘I. F i)"
    and ":β†’: I F ℭ⦇ArrMap⦈ = (Ξ»i∈∘I. ℭ⦇CIdβ¦ˆβ¦‡F i⦈)"
    and [cat_discrete_cs_simps]: ":β†’: I F ℭ⦇HomDom⦈ = :C I"
    and [cat_discrete_cs_simps]: ":β†’: I F ℭ⦇HomCod⦈ = β„­"
  unfolding the_cf_discrete_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda the_cf_discrete_components(1)
  |vsv the_cf_discrete_ObjMap_vsv[cat_discrete_cs_intros]|
  |vdomain the_cf_discrete_ObjMap_vdomain[cat_discrete_cs_simps]|
  |app the_cf_discrete_ObjMap_app[cat_discrete_cs_simps]|

lemma (in cf_discrete) cf_discrete_the_cf_discrete_ObjMap_vrange: 
  "β„›βˆ˜ (:β†’: I F ℭ⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
  using cf_discrete_is_functor_cf_CId_selector_is_arr
  unfolding the_cf_discrete_components
  by (intro vrange_VLambda_vsubset) auto


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda the_cf_discrete_components(2)
  |vsv the_cf_discrete_ArrMap_vsv[cat_discrete_cs_intros]|
  |vdomain the_cf_discrete_ArrMap_vdomain[cat_discrete_cs_simps]|
  |app the_cf_discrete_ArrMap_app[cat_discrete_cs_simps]|

lemma (in cf_discrete) cf_discrete_the_cf_discrete_ArrMap_vrange: 
  "β„›βˆ˜ (:β†’: I F ℭ⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
  using cf_discrete_is_functor_cf_CId_selector_is_arr
  unfolding the_cf_discrete_components
  by (intro vrange_VLambda_vsubset) (auto simp: cf_discrete_selector_vrange)


subsubsectionβ€ΉDiscrete functor is a functorβ€Ί

lemma (in cf_discrete) cf_discrete_the_cf_discrete_is_functor:  
  ":β†’: I F β„­ : :C I ↦↦CΞ± β„­"
proof(intro is_functorI')
  show "vfsequence (:β†’: I F β„­)" unfolding the_cf_discrete_def by simp
  show "category Ξ± (:C I)"
    by 
      (
        simp add:
          cat_discrete_the_cat_discrete 
          cf_discrete_vdomain_vsubset_Vset 
          cat_discrete.axioms(1)
      )  
  show "vcard (:β†’: I F β„­) = 4β„•"
    unfolding the_cf_discrete_def by (simp add: nat_omega_simps)
  show 
    ":β†’: I F ℭ⦇ArrMapβ¦ˆβ¦‡f⦈ : :β†’: I F ℭ⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ :β†’: I F ℭ⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "f : a ↦:C I b" for f a b
  proof-
    from that have fba: "f = a" "b = a" and a: "a ∈∘ I" 
      unfolding the_cat_discrete_is_arrD[OF that] by (simp_all add: β€Ήa ∈∘ Iβ€Ί)
    from that β€Ήa ∈∘ Iβ€Ί show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_discrete_cs_simps fba cs_intro: cat_discrete_cs_intros
        )
  qed
  show ":β†’: I F ℭ⦇ArrMapβ¦ˆβ¦‡g ∘A:C I f⦈ = 
    :β†’: I F ℭ⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­ :β†’: I F ℭ⦇ArrMapβ¦ˆβ¦‡f⦈"
    if "g : b ↦:C I c" and "f : a ↦:C I b" for g b c f a
  proof-
    from that have gfacb: "f = a" "a = b" "g = b" "c = b" and b: "b ∈∘ I"  
      by 
        (
          simp_all add: 
            the_cat_discrete_is_arrD(8-9)[OF that(1)] 
            the_cat_discrete_is_arrD(5-9)[OF that(2)]
        )
    have "F b ∈∘ ℭ⦇Obj⦈" by (simp add: b cf_discrete_selector_vrange)
    from b category_axioms this show ?thesis
      using that 
      unfolding gfacb
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
        )
  qed
  show ":β†’: I F ℭ⦇ArrMapβ¦ˆβ¦‡:C I⦇CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡:β†’: I F ℭ⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
    if "c ∈∘ :C I⦇Obj⦈" for c
    using that
    unfolding the_cat_discrete_components(1)
    by (cs_concl cs_simp: cat_discrete_cs_simps cs_intro: cat_cs_intros)
qed 
  (
    auto simp: 
      the_cf_discrete_components 
      the_cat_discrete_components 
      cat_cs_intros
      cat_discrete_cs_intros
  ) 

lemma (in cf_discrete) cf_discrete_the_cf_discrete_is_functor':
  assumes "𝔄' = :C I" and "β„­' = β„­"
  shows ":β†’: I F β„­ : 𝔄' ↦↦CΞ± β„­'"
  unfolding assms by (rule cf_discrete_the_cf_discrete_is_functor)

lemmas [cat_discrete_cs_intros] = 
  cf_discrete.cf_discrete_the_cf_discrete_is_functor'


subsubsectionβ€ΉUniqueness of the discrete categoryβ€Ί

lemma (in cat_discrete) cat_discrete_iso_the_cat_discrete:
  assumes "I βŠ†βˆ˜ Vset Ξ±" and "I β‰ˆβˆ˜ ℭ⦇Obj⦈"
  obtains F where ":β†’: I F β„­ : :C I ↦↦C.isoΞ± β„­"
proof-

  from assms obtain F where v11_f: "v11 F" 
    and dr[simp]: "π’Ÿβˆ˜ F = I" "β„›βˆ˜ F = ℭ⦇Obj⦈" 
    by auto
  let ?F = "Ξ»i. F⦇i⦈"
  interpret F: v11 F by (rule v11_f)
  from assms(1) interpret β„­: cf_discrete Ξ± I ?F β„­ 
    apply(intro cf_discreteI) 
    unfolding dr[symmetric] 
    by (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
  have ":β†’: I ?F β„­ : :C I ↦↦C.isoΞ± β„­"
  proof(intro is_iso_functorI')
    from β„­.cf_discrete_selector_vrange show  
      ":β†’: I ?F β„­ : :C I ↦↦CΞ± β„­" 
      by (intro cf_discrete.cf_discrete_the_cf_discrete_is_functor cf_discreteI)
        (auto simp: category_axioms assms(1))
    show "v11 (:β†’: I ?F ℭ⦇ArrMap⦈)"
    proof(rule vsv.vsv_valeq_v11I, unfold the_cf_discrete_ArrMap_vdomain)
      fix i j assume prems:
        "i ∈∘ I" "j ∈∘ I" ":β†’: I ?F ℭ⦇ArrMapβ¦ˆβ¦‡i⦈ = :β†’: I ?F ℭ⦇ArrMapβ¦ˆβ¦‡j⦈"
      from prems(3) have "ℭ⦇CIdβ¦ˆβ¦‡?F i⦈ = ℭ⦇CIdβ¦ˆβ¦‡?F j⦈"
        unfolding 
          the_cf_discrete_ArrMap_app[OF prems(1)]
          the_cf_discrete_ArrMap_app[OF prems(2)].
      then have "?F i = ?F j"
        by 
          (
            metis 
              β„­.cf_discrete_is_functor_cf_CId_selector_is_arr 
              prems(1,2) 
              cat_is_arrD(4)
          )
      with F.v11_eq_iff prems show "i = j" by simp
    qed (simp add: the_cf_discrete_components)
    show "β„›βˆ˜ (:β†’: I ?F ℭ⦇ArrMap⦈) = ℭ⦇Arr⦈"
    proof(intro vsubset_antisym vsubsetI)
      fix f assume "f ∈∘ β„›βˆ˜ (:β†’: I ?F ℭ⦇ArrMap⦈)"
      with β„­.cf_discrete_the_cf_discrete_ArrMap_vrange show "f ∈∘ ℭ⦇Arr⦈" 
        by auto
    next
      fix f assume "f ∈∘ ℭ⦇Arr⦈"
      then obtain a b where "f : a ↦ℭ b" by auto
      then obtain a where f_def: "f = ℭ⦇CIdβ¦ˆβ¦‡a⦈" and a: "a ∈∘ ℭ⦇Obj⦈" by auto
      from a F.vrange_atD dr obtain i where a_def: "a = ?F i" and i: "i ∈∘ I"
        by blast
      from a i show "f ∈∘ β„›βˆ˜ (:β†’: I ?F ℭ⦇ArrMap⦈)"
        unfolding a_def f_def the_cf_discrete_components by auto
    qed
  qed (auto simp: v11_f the_cf_discrete_components)
  with that show ?thesis by simp

qed


subsubsectionβ€ΉOpposite discrete functorβ€Ί

lemma (in cf_discrete) cf_discrete_the_cf_discrete_op[cat_op_simps]:
  "op_cf (:β†’: I F β„­) = :β†’: I F (op_cat β„­)"
proof(rule cf_eqI)
  from cf_discrete_vdomain_vsubset_Vset show 
    "op_cf (:β†’: I F β„­) : :C I ↦↦CΞ± op_cat β„­"
    by 
      (
        cs_concl 
          cs_simp: cat_op_simps cs_intro: cat_op_intros cat_discrete_cs_intros
      )
  show ":β†’: I F (op_cat β„­) : :C I ↦↦CΞ± op_cat β„­"
  proof(intro cf_discrete.cf_discrete_the_cf_discrete_is_functor cf_discreteI)
    fix i assume "i ∈∘ I"
    then show "F i ∈∘ op_cat ℭ⦇Obj⦈"
      by (simp add: cat_op_simps cf_discrete_selector_vrange)
  qed (intro cf_discrete_vdomain_vsubset_Vset cat_cs_intros)+
qed (unfold cat_op_simps the_cf_discrete_components, simp_all)

lemmas [cat_op_simps] = cf_discrete.cf_discrete_the_cf_discrete_op

lemma (in cf_discrete) cf_discrete_op[cat_op_intros]: 
  "cf_discrete Ξ± I F (op_cat β„­)"
proof(intro cf_discreteI)
  show "category Ξ± (op_cat β„­)" by (cs_concl cs_intro: cat_cs_intros)
  fix i assume "i ∈∘ I"
  then show "F i ∈∘ op_cat ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_discrete_cs_intros)
qed (intro cf_discrete_vdomain_vsubset_Vset)

lemmas [cat_op_intros] = cf_discrete.cf_discrete_op



subsectionβ€ΉTiny discrete categoryβ€Ί


subsubsectionβ€ΉBackgroundβ€Ί

named_theorems cat_small_discrete_cs_simps
named_theorems cat_small_discrete_cs_intros

lemmas [cat_small_discrete_cs_simps] = cat_discrete_cs_simps
lemmas [cat_small_discrete_cs_intros] = cat_discrete_cs_intros


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale tiny_cat_discrete = cat_discrete Ξ± β„­ + tiny_category Ξ± β„­ for Ξ± β„­


textβ€ΉRules.β€Ί

lemma (in tiny_cat_discrete) tiny_cat_discrete_axioms'[cat_discrete_cs_intros]:
  assumes "Ξ±' = Ξ±" and "β„­' = β„­"
  shows "tiny_cat_discrete Ξ±' β„­'"
  unfolding assms by (rule tiny_cat_discrete_axioms)

mk_ide rf tiny_cat_discrete_def
  |intro tiny_cat_discreteI|
  |dest tiny_cat_discreteD[dest]|
  |elim tiny_cat_discreteE[elim]|

lemmas [cat_small_discrete_cs_intros] = tiny_cat_discreteD

lemma tiny_cat_discreteI':
  assumes "tiny_category Ξ± β„­" and "β‹€f. f ∈∘ ℭ⦇Arr⦈ ⟹ f ∈∘ β„›βˆ˜ (ℭ⦇CId⦈)"
  shows "tiny_cat_discrete Ξ± β„­"
proof(intro tiny_cat_discreteI cat_discreteI)
  interpret tiny_category Ξ± β„­ by (rule assms(1))
  show "category Ξ± β„­" by (auto intro: tiny_dg_category)
  show "f ∈∘ β„›βˆ˜ (ℭ⦇CId⦈)" if "f ∈∘ ℭ⦇Arr⦈" for f using that by (rule assms(2))
qed (auto intro: assms(1))


subsubsectionβ€ΉThe discrete category is a tiny categoryβ€Ί

lemma (in 𝒡) tiny_cat_discrete_the_cat_discrete[cat_small_discrete_cs_intros]:
  assumes "I ∈∘ Vset α"
  shows "tiny_cat_discrete Ξ± (:C I)"
proof(intro tiny_cat_discreteI cat_discrete_the_cat_discrete)
  from assms show "I βŠ†βˆ˜ Vset Ξ±" by auto
  then interpret cat_discrete Ξ± β€Ή:C Iβ€Ί by (intro cat_discrete_the_cat_discrete)
  show "tiny_category Ξ± (:C I)"
    by (intro tiny_categoryI', unfold the_cat_discrete_components)
      (auto intro: cat_cs_intros assms)
qed

lemmas [cat_small_discrete_cs_intros] = 𝒡.cat_discrete_the_cat_discrete



subsectionβ€ΉDiscrete functor with tiny mapsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale tm_cf_discrete = category Ξ± β„­ for Ξ± I F β„­ +
  assumes tm_cf_discrete_selector_vrange[cat_small_discrete_cs_intros]: 
    "i ∈∘ I ⟹ F i ∈∘ ℭ⦇Obj⦈"
    and tm_cf_discrete_ObjMap_in_Vset: "VLambda I F ∈∘ Vset α"
    and tm_cf_discrete_ArrMap_in_Vset: "(Ξ»i∈∘I. ℭ⦇CIdβ¦ˆβ¦‡F i⦈) ∈∘ Vset Ξ±"


textβ€ΉRules.β€Ί

lemma (in tm_cf_discrete) tm_cf_discrete_axioms'[cat_small_discrete_cs_intros]:
  assumes "Ξ±' = Ξ±" and "I' = I" and "F' = F" 
  shows "tm_cf_discrete Ξ±' I' F' β„­"
  unfolding assms by (rule tm_cf_discrete_axioms)

mk_ide rf tm_cf_discrete_def[unfolded tm_cf_discrete_axioms_def]
  |intro tm_cf_discreteI|
  |dest tm_cf_discreteD[dest]|
  |elim tm_cf_discreteE[elim]|

lemma tm_cf_discreteI': 
  assumes "cf_discrete Ξ± I F β„­"
    and "(λi∈∘I. F i) ∈∘ Vset α"
    and "(Ξ»i∈∘I. ℭ⦇CIdβ¦ˆβ¦‡F i⦈) ∈∘ Vset Ξ±"
  shows "tm_cf_discrete Ξ± I F β„­"
proof-
  interpret cf_discrete Ξ± I F β„­ by (rule assms(1))
  show ?thesis
    by (intro tm_cf_discreteI)
      (auto intro: assms cf_discrete_selector_vrange cat_cs_intros)
qed


textβ€ΉElementary properties.β€Ί

sublocale tm_cf_discrete βŠ† cf_discrete
proof(intro cf_discreteI)
  from tm_cf_discrete_ObjMap_in_Vset have "π’Ÿβˆ˜ (Ξ»i∈∘I. F i) ∈∘ Vset Ξ±"
    by (cs_concl cs_intro: vdomain_in_VsetI)
  then show "I βŠ†βˆ˜ Vset Ξ±" by auto
qed (auto intro: cat_cs_intros tm_cf_discrete_selector_vrange)

lemmas (in tm_cf_discrete) tm_cf_discrete_is_cf_discrete_axioms = 
  cf_discrete_axioms

lemmas [cat_small_discrete_cs_intros] = 
  tm_cf_discrete.tm_cf_discrete_is_cf_discrete_axioms

lemma (in tm_cf_discrete) 
  tm_cf_discrete_index_in_Vset[cat_small_discrete_cs_intros]: 
  "I ∈∘ Vset α"
proof-
  from tm_cf_discrete_ObjMap_in_Vset have "π’Ÿβˆ˜ (Ξ»i∈∘I. F i) ∈∘ Vset Ξ±"
    by (cs_concl cs_intro: vdomain_in_VsetI)
  then show ?thesis by simp
qed


subsubsectionβ€ΉOpposite discrete functor with tiny mapsβ€Ί

lemma (in tm_cf_discrete) tm_cf_discrete_op[cat_op_intros]: 
  "tm_cf_discrete Ξ± I F (op_cat β„­)"
  using tm_cf_discrete_ObjMap_in_Vset tm_cf_discrete_ArrMap_in_Vset 
  by (intro tm_cf_discreteI' cf_discrete_op) (auto simp: cat_op_simps)

lemmas [cat_op_intros] = tm_cf_discrete.tm_cf_discrete_op


subsubsectionβ€ΉDiscrete functor with tiny maps is a functor with tiny mapsβ€Ί

lemma (in tm_cf_discrete) tm_cf_discrete_the_cf_discrete_is_tm_functor: 
  ":β†’: I F β„­ : :C I ↦↦C.tmΞ± β„­"
  by (intro is_tm_functorI' cf_discrete_the_cf_discrete_is_functor)
    (
      auto simp: 
        the_cf_discrete_components 
        tm_cf_discrete_ObjMap_in_Vset 
        tm_cf_discrete_ArrMap_in_Vset
    )

lemma (in tm_cf_discrete) tm_cf_discrete_the_cf_discrete_is_tm_functor':
  assumes "𝔄' = :C I" and "β„­' = β„­"
  shows ":β†’: I F β„­ : 𝔄' ↦↦C.tmΞ± β„­'"
  unfolding assms by (rule tm_cf_discrete_the_cf_discrete_is_tm_functor)

lemmas [cat_discrete_cs_intros] = 
  tm_cf_discrete.tm_cf_discrete_the_cf_discrete_is_tm_functor'

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_SS

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ίβ€Ί
theory CZH_ECAT_SS
  imports CZH_ECAT_Small_Functor
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
General information about β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ί (also known as 
cospans and spans, respectively) can be found in in Chapters III-3 and III-4 
in \cite{mac_lane_categories_2010}, as well as 
nLab \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/cospan}
}\footnote{\url{https://ncatlab.org/nlab/show/span}}.
β€Ί

named_theorems cat_ss_cs_simps
named_theorems cat_ss_cs_intros

named_theorems cat_ss_elem_simps

definition 𝔬SS where [cat_ss_elem_simps]: "𝔬SS = 0"
definition π”žSS where [cat_ss_elem_simps]: "π”žSS = 1β„•"
definition π”ŸSS where [cat_ss_elem_simps]: "π”ŸSS = 2β„•"
definition 𝔀SS where [cat_ss_elem_simps]: "𝔀SS = 3β„•"
definition 𝔣SS where [cat_ss_elem_simps]: "𝔣SS = 4β„•"

lemma cat_ss_ineq:
  shows cat_ss_π”žπ”Ÿ[cat_ss_cs_intros]: "π”žSS β‰  π”ŸSS"
    and cat_ss_π”žπ”¬[cat_ss_cs_intros]: "π”žSS β‰  𝔬SS"
    and cat_ss_π”Ÿπ”¬[cat_ss_cs_intros]: "π”ŸSS β‰  𝔬SS"
    and cat_ss_𝔀𝔣[cat_ss_cs_intros]: "𝔀SS β‰  𝔣SS"
    and cat_ss_π”€π”ž[cat_ss_cs_intros]: "𝔀SS β‰  π”žSS"
    and cat_ss_π”€π”Ÿ[cat_ss_cs_intros]: "𝔀SS β‰  π”ŸSS"
    and cat_ss_𝔀𝔬[cat_ss_cs_intros]: "𝔀SS β‰  𝔬SS"
    and cat_ss_π”£π”ž[cat_ss_cs_intros]: "𝔣SS β‰  π”žSS"
    and cat_ss_π”£π”Ÿ[cat_ss_cs_intros]: "𝔣SS β‰  π”ŸSS"
    and cat_ss_𝔣𝔬[cat_ss_cs_intros]: "𝔣SS β‰  𝔬SS"
  unfolding cat_ss_elem_simps by simp_all

lemma (in 𝒡) 
  shows cat_ss_π”ž[cat_ss_cs_intros]: "π”žSS ∈∘ Vset Ξ±"
    and cat_ss_π”Ÿ[cat_ss_cs_intros]: "π”ŸSS ∈∘ Vset Ξ±"
    and cat_ss_𝔬[cat_ss_cs_intros]: "𝔬SS ∈∘ Vset Ξ±"
    and cat_ss_𝔀[cat_ss_cs_intros]: "𝔀SS ∈∘ Vset Ξ±"
    and cat_ss_𝔣[cat_ss_cs_intros]: "𝔣SS ∈∘ Vset Ξ±"
  unfolding cat_ss_elem_simps by simp_all



subsectionβ€ΉComposable arrows in β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ίβ€Ί

abbreviation cat_scospan_composable :: V
  where "cat_scospan_composable ≑ 
    (set {𝔬SS} Γ—βˆ™ set {𝔬SS, 𝔀SS, 𝔣SS}) βˆͺ∘ 
    (set {𝔀SS, π”žSS} Γ—βˆ™ set {π”žSS}) βˆͺ∘ 
    (set {𝔣SS, π”ŸSS} Γ—βˆ™ set {π”ŸSS})"

abbreviation cat_sspan_composable :: V
  where "cat_sspan_composable ≑ (cat_scospan_composable)Β―βˆ™"


textβ€ΉRules.β€Ί

lemma cat_scospan_composable_𝔬𝔬[cat_ss_cs_intros]:
  assumes "g = 𝔬SS" and "f = 𝔬SS"
  shows "[g, f]∘ ∈∘ cat_scospan_composable"
  using assms by auto

lemma cat_scospan_composable_𝔬𝔀[cat_ss_cs_intros]:
  assumes "g = 𝔬SS" and "f = 𝔀SS"
  shows "[g, f]∘ ∈∘ cat_scospan_composable"
  using assms by auto

lemma cat_scospan_composable_𝔬𝔣[cat_ss_cs_intros]:
  assumes "g = 𝔬SS" and "f = 𝔣SS"
  shows "[g, f]∘ ∈∘ cat_scospan_composable"
  using assms by auto

lemma cat_scospan_composable_π”€π”ž[cat_ss_cs_intros]:
  assumes "g = 𝔀SS" and "f = π”žSS"
  shows "[g, f]∘ ∈∘ cat_scospan_composable"
  using assms by auto

lemma cat_scospan_composable_π”£π”Ÿ[cat_ss_cs_intros]:
  assumes "g = 𝔣SS" and "f = π”ŸSS"
  shows "[g, f]∘ ∈∘ cat_scospan_composable"
  using assms by auto

lemma cat_scospan_composable_π”žπ”ž[cat_ss_cs_intros]:
  assumes "g = π”žSS" and "f = π”žSS"
  shows "[g, f]∘ ∈∘ cat_scospan_composable"
  using assms by auto

lemma cat_scospan_composable_π”Ÿπ”Ÿ[cat_ss_cs_intros]:
  assumes "g = π”ŸSS" and "f = π”ŸSS"
  shows "[g, f]∘ ∈∘ cat_scospan_composable"
  using assms by auto

lemma cat_scospan_composableE:
  assumes "[g, f]∘ ∈∘ cat_scospan_composable"
  obtains "g = 𝔬SS" and "f = 𝔬SS" 
        | "g = 𝔬SS" and "f = 𝔀SS"
        | "g = 𝔬SS" and "f = 𝔣SS"
        | "g = 𝔀SS" and "f = π”žSS"
        | "g = 𝔣SS" and "f = π”ŸSS"
        | "g = π”žSS" and "f = π”žSS"
        | "g = π”ŸSS" and "f = π”ŸSS"
  using assms that by auto

lemma cat_sspan_composable_𝔬𝔬[cat_ss_cs_intros]:
  assumes "g = 𝔬SS" and "f = 𝔬SS"
  shows "[g, f]∘ ∈∘ cat_sspan_composable"
  using assms by auto

lemma cat_sspan_composable_𝔀𝔬[cat_ss_cs_intros]:
  assumes "g = 𝔀SS" and "f = 𝔬SS"
  shows "[g, f]∘ ∈∘ cat_sspan_composable"
  using assms by auto

lemma cat_sspan_composable_𝔣𝔬[cat_ss_cs_intros]:
  assumes "g = 𝔣SS" and "f = 𝔬SS"
  shows "[g, f]∘ ∈∘ cat_sspan_composable"
  using assms by auto

lemma cat_sspan_composable_π”žπ”€[cat_ss_cs_intros]:
  assumes "g = π”žSS" and "f = 𝔀SS"
  shows "[g, f]∘ ∈∘ cat_sspan_composable"
  using assms by auto

lemma cat_sspan_composable_π”Ÿπ”£[cat_ss_cs_intros]:
  assumes "g = π”ŸSS" and "f = 𝔣SS"
  shows "[g, f]∘ ∈∘ cat_sspan_composable"
  using assms by auto

lemma cat_sspan_composable_π”žπ”ž[cat_ss_cs_intros]:
  assumes "g = π”žSS" and "f = π”žSS"
  shows "[g, f]∘ ∈∘ cat_sspan_composable"
  using assms by auto

lemma cat_sspan_composable_π”Ÿπ”Ÿ[cat_ss_cs_intros]:
  assumes "g = π”ŸSS" and "f = π”ŸSS"
  shows "[g, f]∘ ∈∘ cat_sspan_composable"
  using assms by auto

lemma cat_sspan_composableE:
  assumes "[g, f]∘ ∈∘ cat_sspan_composable"
  obtains "g = 𝔬SS" and "f = 𝔬SS" 
        | "g = 𝔀SS" and "f = 𝔬SS"
        | "g = 𝔣SS" and "f = 𝔬SS"
        | "g = π”žSS" and "f = 𝔀SS"
        | "g = π”ŸSS" and "f = 𝔣SS"
        | "g = π”žSS" and "f = π”žSS"
        | "g = π”ŸSS" and "f = π”ŸSS"
  using assms that by auto



subsectionβ€ΉCategories β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III-3 and Chapter III-4 in \cite{mac_lane_categories_2010}.β€Ί

definition the_cat_scospan :: V (β€Ήβ†’βˆ™β†Cβ€Ί)
  where "β†’βˆ™β†C =
    [
      set {π”žSS, π”ŸSS, 𝔬SS},
      set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS},
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | x = 𝔀SS β‡’ π”žSS
          | x = 𝔣SS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      ),
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      ),
      (
        λgf∈∘cat_scospan_composable. 
         if gf = [𝔬SS, 𝔀SS]∘ β‡’ 𝔀SS
          | gf = [𝔬SS, 𝔣SS]∘ β‡’ 𝔣SS
          | otherwise β‡’ gf⦇0⦈
      ),
      vid_on (set {π”žSS, π”ŸSS, 𝔬SS})
    ]∘"

definition the_cat_sspan :: V (β€Ήβ†βˆ™β†’Cβ€Ί)
  where "β†βˆ™β†’C =
    [
      set {π”žSS, π”ŸSS, 𝔬SS},
      set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS},
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      ),
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | x = 𝔀SS β‡’ π”žSS
          | x = 𝔣SS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      ),
      (
        λgf∈∘cat_sspan_composable. 
         if gf = [π”žSS, 𝔀SS]∘ β‡’ 𝔀SS
          | gf = [π”ŸSS, 𝔣SS]∘ β‡’ 𝔣SS
          | otherwise β‡’ gf⦇0⦈
      ),
      vid_on (set {π”žSS, π”ŸSS, 𝔬SS})
    ]∘"


textβ€ΉComponents.β€Ί

lemma the_cat_scospan_components: 
  shows "β†’βˆ™β†C⦇Obj⦈ = set {π”žSS, π”ŸSS, 𝔬SS}"
    and "β†’βˆ™β†C⦇Arr⦈ = set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}"
    and "β†’βˆ™β†C⦇Dom⦈ = 
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | x = 𝔀SS β‡’ π”žSS
          | x = 𝔣SS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      )"
    and "β†’βˆ™β†C⦇Cod⦈ = 
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      )"
    and "β†’βˆ™β†C⦇Comp⦈ =
      (
        λgf∈∘cat_scospan_composable. 
         if gf = [𝔬SS, 𝔀SS]∘ β‡’ 𝔀SS
          | gf = [𝔬SS, 𝔣SS]∘ β‡’ 𝔣SS
          | otherwise β‡’ gf⦇0⦈
      )"
    and "β†’βˆ™β†C⦇CId⦈ = vid_on (set {π”žSS, π”ŸSS, 𝔬SS})"
  unfolding the_cat_scospan_def dg_field_simps by (simp_all add: nat_omega_simps)

lemma the_cat_sspan_components: 
  shows "β†βˆ™β†’C⦇Obj⦈ = set {π”žSS, π”ŸSS, 𝔬SS}"
    and "β†βˆ™β†’C⦇Arr⦈ = set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}"
    and "β†βˆ™β†’C⦇Dom⦈ =
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      )"
    and "β†βˆ™β†’C⦇Cod⦈ =
      (
        Ξ»x∈∘set {π”žSS, 𝔀SS, 𝔬SS, 𝔣SS, π”ŸSS}. 
         if x = π”žSS β‡’ π”žSS
          | x = π”ŸSS β‡’ π”ŸSS
          | x = 𝔀SS β‡’ π”žSS
          | x = 𝔣SS β‡’ π”ŸSS
          | otherwise β‡’ 𝔬SS
      )"
    and "β†βˆ™β†’C⦇Comp⦈ =
      (
        λgf∈∘cat_sspan_composable. 
         if gf = [π”žSS, 𝔀SS]∘ β‡’ 𝔀SS
          | gf = [π”ŸSS, 𝔣SS]∘ β‡’ 𝔣SS
          | otherwise β‡’ gf⦇0⦈
      )"
    and "β†βˆ™β†’C⦇CId⦈ = vid_on (set {π”žSS, π”ŸSS, 𝔬SS})"
  unfolding the_cat_sspan_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉElementary properties.β€Ί

lemma the_cat_scospan_components_vsv[cat_ss_cs_intros]: "vsv (β†’βˆ™β†C)"
  unfolding the_cat_scospan_def by auto

lemma the_cat_sspan_components_vsv[cat_ss_cs_intros]: "vsv (β†βˆ™β†’C)"
  unfolding the_cat_sspan_def by auto


subsubsectionβ€ΉObjectsβ€Ί

lemma the_cat_scospan_Obj_𝔬I[cat_ss_cs_intros]:
  assumes "a = 𝔬SS"
  shows "a ∈∘ β†’βˆ™β†C⦇Obj⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_Obj_π”žI[cat_ss_cs_intros]:
  assumes "a = π”žSS"
  shows "a ∈∘ β†’βˆ™β†C⦇Obj⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_Obj_π”ŸI[cat_ss_cs_intros]:
  assumes "a = π”ŸSS"
  shows "a ∈∘ β†’βˆ™β†C⦇Obj⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_ObjE:
  assumes "a ∈∘ β†’βˆ™β†C⦇Obj⦈"
  obtains β€Ήa = 𝔬SSβ€Ί | β€Ήa = π”žSSβ€Ί | β€Ήa = π”ŸSSβ€Ί
  using assms unfolding the_cat_scospan_components by auto

lemma the_cat_sspan_Obj_𝔬I[cat_ss_cs_intros]:
  assumes "a = 𝔬SS"
  shows "a ∈∘ β†βˆ™β†’C⦇Obj⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_Obj_π”žI[cat_ss_cs_intros]:
  assumes "a = π”žSS"
  shows "a ∈∘ β†βˆ™β†’C⦇Obj⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_Obj_π”ŸI[cat_ss_cs_intros]:
  assumes "a = π”ŸSS"
  shows "a ∈∘ β†βˆ™β†’C⦇Obj⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_ObjE:
  assumes "a ∈∘ β†βˆ™β†’C⦇Obj⦈"
  obtains β€Ήa = 𝔬SSβ€Ί | β€Ήa = π”žSSβ€Ί | β€Ήa = π”ŸSSβ€Ί
  using assms unfolding the_cat_sspan_components by auto


subsubsectionβ€ΉArrowsβ€Ί

lemma the_cat_scospan_Arr_π”žI[cat_ss_cs_intros]:
  assumes "a = π”žSS"
  shows "a ∈∘ β†’βˆ™β†C⦇Arr⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_Arr_π”ŸI[cat_ss_cs_intros]:
  assumes "a = π”ŸSS"
  shows "a ∈∘ β†’βˆ™β†C⦇Arr⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_Arr_𝔬I[cat_ss_cs_intros]:
  assumes "a = 𝔬SS"
  shows "a ∈∘ β†’βˆ™β†C⦇Arr⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_Arr_𝔀I[cat_ss_cs_intros]:
  assumes "a = 𝔀SS"
  shows "a ∈∘ β†’βˆ™β†C⦇Arr⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_Arr_𝔣I[cat_ss_cs_intros]:
  assumes "a = 𝔣SS"
  shows "a ∈∘ β†’βˆ™β†C⦇Arr⦈"
  using assms unfolding the_cat_scospan_components by simp

lemma the_cat_scospan_ArrE:
  assumes "f ∈∘ β†’βˆ™β†C⦇Arr⦈"
  obtains β€Ήf = π”žSSβ€Ί | β€Ήf = π”ŸSSβ€Ί | β€Ήf = 𝔬SSβ€Ί | β€Ήf = 𝔀SSβ€Ί | β€Ήf = 𝔣SSβ€Ί 
  using assms unfolding the_cat_scospan_components by auto

lemma the_cat_sspan_Arr_π”žI[cat_ss_cs_intros]:
  assumes "a = π”žSS"
  shows "a ∈∘ β†βˆ™β†’C⦇Arr⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_Arr_π”ŸI[cat_ss_cs_intros]:
  assumes "a = π”ŸSS"
  shows "a ∈∘ β†βˆ™β†’C⦇Arr⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_Arr_𝔬I[cat_ss_cs_intros]:
  assumes "a = 𝔬SS"
  shows "a ∈∘ β†βˆ™β†’C⦇Arr⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_Arr_𝔀I[cat_ss_cs_intros]:
  assumes "a = 𝔀SS"
  shows "a ∈∘ β†βˆ™β†’C⦇Arr⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_Arr_𝔣I[cat_ss_cs_intros]:
  assumes "a = 𝔣SS"
  shows "a ∈∘ β†βˆ™β†’C⦇Arr⦈"
  using assms unfolding the_cat_sspan_components by simp

lemma the_cat_sspan_ArrE:
  assumes "f ∈∘ β†βˆ™β†’C⦇Arr⦈"
  obtains β€Ήf = π”žSSβ€Ί | β€Ήf = π”ŸSSβ€Ί | β€Ήf = 𝔬SSβ€Ί | β€Ήf = 𝔀SSβ€Ί | β€Ήf = 𝔣SSβ€Ί 
  using assms unfolding the_cat_sspan_components by auto


subsubsectionβ€ΉDomainβ€Ί

mk_VLambda the_cat_scospan_components(3)
  |vsv the_cat_scospan_Dom_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_scospan_Dom_vdomain[cat_ss_cs_simps]|

lemma the_cat_scospan_Dom_app_π”ž[cat_ss_cs_simps]:
  assumes "f = π”žSS"
  shows "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡f⦈ = π”žSS"
  unfolding the_cat_scospan_components assms by simp

lemma the_cat_scospan_Dom_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "f = π”ŸSS"
  shows "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡f⦈ = π”ŸSS"
  unfolding the_cat_scospan_components assms by simp

lemma the_cat_scospan_Dom_app_𝔬[cat_ss_cs_simps]:
  assumes "f = 𝔬SS"
  shows "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

lemma the_cat_scospan_Dom_app_𝔀[cat_ss_cs_simps]:
  assumes "f = 𝔀SS"
  shows "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡f⦈ = π”žSS"
  unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

lemma the_cat_scospan_Dom_app_𝔣[cat_ss_cs_simps]:
  assumes "f = 𝔣SS"
  shows "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡f⦈ = π”ŸSS"
  unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

mk_VLambda the_cat_sspan_components(3)
  |vsv the_cat_sspan_Dom_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_sspan_Dom_vdomain[cat_ss_cs_simps]|

lemma the_cat_sspan_Dom_app_π”ž[cat_ss_cs_simps]:
  assumes "f = π”žSS"
  shows "β†βˆ™β†’C⦇Domβ¦ˆβ¦‡f⦈ = π”žSS"
  unfolding the_cat_sspan_components assms by simp

lemma the_cat_sspan_Dom_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "f = π”ŸSS"
  shows "β†βˆ™β†’C⦇Domβ¦ˆβ¦‡f⦈ = π”ŸSS"
  unfolding the_cat_sspan_components assms by simp

lemma the_cat_sspan_Dom_app_𝔬[cat_ss_cs_simps]:
  assumes "f = 𝔬SS"
  shows "β†βˆ™β†’C⦇Domβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

lemma the_cat_sspan_Dom_app_𝔀[cat_ss_cs_simps]:
  assumes "f = 𝔀SS"
  shows "β†βˆ™β†’C⦇Domβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

lemma the_cat_sspan_Dom_app_𝔣[cat_ss_cs_simps]:
  assumes "f = 𝔣SS"
  shows "β†βˆ™β†’C⦇Domβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_sspan_components assms using cat_ss_ineq by auto


subsubsectionβ€ΉCodomainβ€Ί

mk_VLambda the_cat_scospan_components(4)
  |vsv the_cat_scospan_Cod_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_scospan_Cod_vdomain[cat_ss_cs_simps]|

lemma the_cat_scospan_Cod_app_π”ž[cat_ss_cs_simps]:
  assumes "f = π”žSS"
  shows "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡f⦈ = π”žSS"
  unfolding the_cat_scospan_components assms by simp

lemma the_cat_scospan_Cod_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "f = π”ŸSS"
  shows "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡f⦈ = π”ŸSS"
  unfolding the_cat_scospan_components assms by simp

lemma the_cat_scospan_Cod_app_𝔬[cat_ss_cs_simps]:
  assumes "f = 𝔬SS"
  shows "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

lemma the_cat_scospan_Cod_app_𝔀[cat_ss_cs_simps]:
  assumes "f = 𝔀SS"
  shows "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

lemma the_cat_scospan_Cod_app_𝔣[cat_ss_cs_simps]:
  assumes "f = 𝔣SS"
  shows "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

mk_VLambda the_cat_sspan_components(4)
  |vsv the_cat_sspan_Cod_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_sspan_Cod_vdomain[cat_ss_cs_simps]|

lemma the_cat_sspan_Cod_app_π”ž[cat_ss_cs_simps]:
  assumes "f = π”žSS"
  shows "β†βˆ™β†’C⦇Codβ¦ˆβ¦‡f⦈ = π”žSS"
  unfolding the_cat_sspan_components assms by simp

lemma the_cat_sspan_Cod_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "f = π”ŸSS"
  shows "β†βˆ™β†’C⦇Codβ¦ˆβ¦‡f⦈ = π”ŸSS"
  unfolding the_cat_sspan_components assms by simp

lemma the_cat_sspan_Cod_app_𝔬[cat_ss_cs_simps]:
  assumes "f = 𝔬SS"
  shows "β†βˆ™β†’C⦇Codβ¦ˆβ¦‡f⦈ = 𝔬SS"
  unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

lemma the_cat_sspan_Cod_app_𝔀[cat_ss_cs_simps]:
  assumes "f = 𝔀SS"
  shows "β†βˆ™β†’C⦇Codβ¦ˆβ¦‡f⦈ = π”žSS"
  unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

lemma the_cat_sspan_Cod_app_𝔣[cat_ss_cs_simps]:
  assumes "f = 𝔣SS"
  shows "β†βˆ™β†’C⦇Codβ¦ˆβ¦‡f⦈ = π”ŸSS"
  unfolding the_cat_sspan_components assms using cat_ss_ineq by auto


subsubsectionβ€ΉCompositionβ€Ί

mk_VLambda the_cat_scospan_components(5)
  |vsv the_cat_scospan_Comp_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_scospan_Comp_vdomain[cat_ss_cs_simps]|

lemma the_cat_scospan_Comp_app_π”žπ”ž[cat_ss_cs_simps]:
  assumes "g = π”žSS" and "f = π”žSS"
  shows "g ∘Aβ†’βˆ™β†C f = g" "g ∘Aβ†’βˆ™β†C f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_scospan_composable" by auto
  with assms show "g ∘Aβ†’βˆ™β†C f = g" "g ∘Aβ†’βˆ™β†C f = f"
    unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
qed

lemma the_cat_scospan_Comp_app_π”Ÿπ”Ÿ[cat_ss_cs_simps]:
  assumes "g = π”ŸSS" and "f = π”ŸSS"
  shows "g ∘Aβ†’βˆ™β†C f = g" "g ∘Aβ†’βˆ™β†C f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_scospan_composable" by auto
  with assms show "g ∘Aβ†’βˆ™β†C f = g" "g ∘Aβ†’βˆ™β†C f = f"
    unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
qed

lemma the_cat_scospan_Comp_app_𝔬𝔬[cat_ss_cs_simps]:
  assumes "g = 𝔬SS" and "f = 𝔬SS"
  shows "g ∘Aβ†’βˆ™β†C f = g" "g ∘Aβ†’βˆ™β†C f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_scospan_composable" by auto
  with assms show "g ∘Aβ†’βˆ™β†C f = g" "g ∘Aβ†’βˆ™β†C f = f"
    unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
qed

lemma the_cat_scospan_Comp_app_𝔬𝔀[cat_ss_cs_simps]:
  assumes "g = 𝔬SS" and "f = 𝔀SS"
  shows "g ∘Aβ†’βˆ™β†C f = f" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_scospan_composable" by auto
  then show "g ∘Aβ†’βˆ™β†C f = f" 
    unfolding the_cat_scospan_components(5) assms by (auto simp: nat_omega_simps)
qed

lemma the_cat_scospan_Comp_app_𝔬𝔣[cat_ss_cs_simps]:
  assumes "g = 𝔬SS" and "f = 𝔣SS"
  shows "g ∘Aβ†’βˆ™β†C f = f" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_scospan_composable" by auto
  then show "g ∘Aβ†’βˆ™β†C f = f" 
    unfolding the_cat_scospan_components(5) assms by (auto simp: nat_omega_simps)
qed

lemma the_cat_scospan_Comp_app_π”€π”ž[cat_ss_cs_simps]:
  assumes "g = 𝔀SS" and "f = π”žSS"
  shows "g ∘Aβ†’βˆ™β†C f = g"  
proof-
  from assms have "[g, f]∘ ∈∘ cat_scospan_composable" by auto
  then show "g ∘Aβ†’βˆ™β†C f = g" 
    unfolding the_cat_scospan_components(5) assms 
    using cat_ss_ineq
    by (auto simp: nat_omega_simps)
qed

lemma the_cat_scospan_Comp_app_π”£π”Ÿ[cat_ss_cs_simps]:
  assumes "g = 𝔣SS" and "f = π”ŸSS"
  shows "g ∘Aβ†’βˆ™β†C f = g"  
proof-
  from assms have "[g, f]∘ ∈∘ cat_scospan_composable" by auto
  then show "g ∘Aβ†’βˆ™β†C f = g" 
    unfolding the_cat_scospan_components(5) assms 
    using cat_ss_ineq
    by (auto simp: nat_omega_simps)
qed

mk_VLambda the_cat_sspan_components(5)
  |vsv the_cat_sspan_Comp_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_sspan_Comp_vdomain[cat_ss_cs_simps]|

lemma the_cat_sspan_Comp_app_π”žπ”ž[cat_ss_cs_simps]:
  assumes "g = π”žSS" and "f = π”žSS"
  shows "g ∘Aβ†βˆ™β†’C f = g" "g ∘Aβ†βˆ™β†’C f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_sspan_composable" by auto
  with assms show "g ∘Aβ†βˆ™β†’C f = g" "g ∘Aβ†βˆ™β†’C f = f"
    unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
qed

lemma the_cat_sspan_Comp_app_π”Ÿπ”Ÿ[cat_ss_cs_simps]:
  assumes "g = π”ŸSS" and "f = π”ŸSS"
  shows "g ∘Aβ†βˆ™β†’C f = g" "g ∘Aβ†βˆ™β†’C f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_sspan_composable" by auto
  with assms show "g ∘Aβ†βˆ™β†’C f = g" "g ∘Aβ†βˆ™β†’C f = f"
    unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
qed

lemma the_cat_sspan_Comp_app_𝔬𝔬[cat_ss_cs_simps]:
  assumes "g = 𝔬SS" and "f = 𝔬SS"
  shows "g ∘Aβ†βˆ™β†’C f = g" "g ∘Aβ†βˆ™β†’C f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_sspan_composable" by auto
  with assms show "g ∘Aβ†βˆ™β†’C f = g" "g ∘Aβ†βˆ™β†’C f = f"
    unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
qed

lemma the_cat_sspan_Comp_app_π”žπ”€[cat_ss_cs_simps]:
  assumes "g = π”žSS" and "f = 𝔀SS"
  shows "g ∘Aβ†βˆ™β†’C f = f" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_sspan_composable" by auto
  then show "g ∘Aβ†βˆ™β†’C f = f" 
    unfolding the_cat_sspan_components(5) assms by (auto simp: nat_omega_simps)
qed

lemma the_cat_sspan_Comp_app_π”Ÿπ”£[cat_ss_cs_simps]:
  assumes "g = π”ŸSS" and "f = 𝔣SS"
  shows "g ∘Aβ†βˆ™β†’C f = f" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_sspan_composable" by auto
  then show "g ∘Aβ†βˆ™β†’C f = f" 
    unfolding the_cat_sspan_components(5) assms by (auto simp: nat_omega_simps)
qed

lemma the_cat_sspan_Comp_app_𝔀𝔬[cat_ss_cs_simps]:
  assumes "g = 𝔀SS" and "f = 𝔬SS"
  shows "g ∘Aβ†βˆ™β†’C f = g"  
proof-
  from assms have "[g, f]∘ ∈∘ cat_sspan_composable" by auto
  then show "g ∘Aβ†βˆ™β†’C f = g" 
    unfolding the_cat_sspan_components(5) assms 
    using cat_ss_ineq
    by (auto simp: nat_omega_simps)
qed

lemma the_cat_sspan_Comp_app_𝔣𝔬[cat_ss_cs_simps]:
  assumes "g = 𝔣SS" and "f = 𝔬SS"
  shows "g ∘Aβ†βˆ™β†’C f = g"  
proof-
  from assms have "[g, f]∘ ∈∘ cat_sspan_composable" by auto
  then show "g ∘Aβ†βˆ™β†’C f = g" 
    unfolding the_cat_sspan_components(5) assms 
    using cat_ss_ineq
    by (auto simp: nat_omega_simps)
qed


subsubsectionβ€ΉIdentityβ€Ί

mk_VLambda the_cat_scospan_components(6)[folded VLambda_vid_on]
  |vsv the_cat_scospan_CId_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_scospan_CId_vdomain[cat_ss_cs_simps]|
  |app the_cat_scospan_CId_app[cat_ss_cs_simps]|

mk_VLambda the_cat_sspan_components(6)[folded VLambda_vid_on]
  |vsv the_cat_sspan_CId_vsv[cat_ss_cs_intros]|
  |vdomain the_cat_sspan_CId_vdomain[cat_ss_cs_simps]|
  |app the_cat_sspan_CId_app[cat_ss_cs_simps]|


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma the_cat_scospan_is_arr_π”žπ”žπ”ž[cat_ss_cs_intros]:
  assumes "a' = π”žSS" and "b' = π”žSS" and "f = π”žSS"
  shows "f : a' β†¦β†’βˆ™β†C b'"
proof(intro is_arrI, unfold assms)
  show "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡π”žSS⦈ = π”žSS" "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡π”žSS⦈ = π”žSS"
    by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)

lemma the_cat_scospan_is_arr_π”Ÿπ”Ÿπ”Ÿ[cat_ss_cs_intros]:
  assumes "a' = π”ŸSS" and "b' = π”ŸSS" and "f = π”ŸSS"
  shows "f : a' β†¦β†’βˆ™β†C b'"
proof(intro is_arrI, unfold assms)
  show "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡π”ŸSS⦈ = π”ŸSS" "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡π”ŸSS⦈ = π”ŸSS"
    by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)

lemma the_cat_scospan_is_arr_𝔬𝔬𝔬[cat_ss_cs_intros]:
  assumes "a' = 𝔬SS" and "b' = 𝔬SS" and "f = 𝔬SS"
  shows "f : a' β†¦β†’βˆ™β†C b'"
proof(intro is_arrI, unfold assms)
  show "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡π”¬SS⦈ = 𝔬SS" "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡π”¬SS⦈ = 𝔬SS"
    by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)

lemma the_cat_scospan_is_arr_π”žπ”¬π”€[cat_ss_cs_intros]:
  assumes "a' = π”žSS" and "b' = 𝔬SS" and "f = 𝔀SS"
  shows "f : a' β†¦β†’βˆ™β†C b'"
proof(intro is_arrI, unfold assms)
  show "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡π”€SS⦈ = π”žSS" "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡π”€SS⦈ = 𝔬SS"
    by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)

lemma the_cat_scospan_is_arr_π”Ÿπ”¬π”£[cat_ss_cs_intros]:
  assumes "a' = π”ŸSS" and "b' = 𝔬SS" and "f = 𝔣SS"
  shows "f : a' β†¦β†’βˆ™β†C b'"
proof(intro is_arrI, unfold assms)
  show "β†’βˆ™β†C⦇Domβ¦ˆβ¦‡π”£SS⦈ = π”ŸSS" "β†’βˆ™β†C⦇Codβ¦ˆβ¦‡π”£SS⦈ = 𝔬SS"
    by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)

lemma the_cat_scospan_is_arrE:
  assumes "f' : a' β†¦β†’βˆ™β†C b'"
  obtains "a' = π”žSS" and "b' = π”žSS" and "f' = π”žSS"
        | "a' = π”ŸSS" and "b' = π”ŸSS" and "f' = π”ŸSS"
        | "a' = 𝔬SS" and "b' = 𝔬SS" and "f' = 𝔬SS"
        | "a' = π”žSS" and "b' = 𝔬SS" and "f' = 𝔀SS"
        | "a' = π”ŸSS" and "b' = 𝔬SS" and "f' = 𝔣SS"
proof-
  note f = is_arrD[OF assms]
  from f(1) consider (π”žSS) β€Ήf' = π”žSSβ€Ί 
                   | (π”ŸSS) β€Ήf' = π”ŸSSβ€Ί 
                   | (𝔬SS) β€Ήf' = 𝔬SSβ€Ί 
                   | (𝔀SS) β€Ήf' = 𝔀SSβ€Ί 
                   | (𝔣SS) β€Ήf' = 𝔣SSβ€Ί 
    by (elim the_cat_scospan_ArrE)
  then show ?thesis
  proof cases
    case π”žSS
    moreover from f(2,3)[unfolded π”žSS, symmetric] have "a' = π”žSS" "b' = π”žSS"
      by (simp_all add: cat_ss_cs_simps)
    ultimately show ?thesis using that by auto
  next
    case π”ŸSS
    moreover from f(2,3)[unfolded π”ŸSS, symmetric] have "a' = π”ŸSS" "b' = π”ŸSS"
      by (simp_all add: cat_ss_cs_simps)
    ultimately show ?thesis using that by auto
  next
    case 𝔬SS
    moreover from f(2,3)[unfolded 𝔬SS, symmetric] have "a' = 𝔬SS" "b' = 𝔬SS"
      by (simp_all add: cat_ss_cs_simps)
    ultimately show ?thesis using that by auto
  next
    case 𝔀SS
    moreover have "a' = π”žSS" "b' = 𝔬SS"
      by (simp_all add: f(2,3)[unfolded 𝔀SS, symmetric] cat_ss_cs_simps)
    ultimately show ?thesis using that by auto
  next
    case 𝔣SS
    moreover have "a' = π”ŸSS" "b' = 𝔬SS"
      by (simp_all add: f(2,3)[unfolded 𝔣SS, symmetric] cat_ss_cs_simps)
    ultimately show ?thesis using that by auto
  qed
qed


subsubsectionβ€Ήβ€Ήβ†’βˆ™β†β€Ί is a finite categoryβ€Ί

lemma (in 𝒡) finite_category_the_cat_scospan[cat_ss_cs_intros]:
  "finite_category Ξ± (β†’βˆ™β†C)"
proof(intro finite_categoryI'' tiny_categoryI'')
  show "vfsequence (β†’βˆ™β†C)" unfolding the_cat_scospan_def by simp
  show "vcard (β†’βˆ™β†C) = 6β„•"
    unfolding the_cat_scospan_def by (simp_all add: nat_omega_simps)
  show "β„›βˆ˜ (β†’βˆ™β†C⦇Dom⦈) βŠ†βˆ˜ β†’βˆ™β†C⦇Obj⦈" by (auto simp: the_cat_scospan_components)
  show "β„›βˆ˜ (β†’βˆ™β†C⦇Cod⦈) βŠ†βˆ˜ β†’βˆ™β†C⦇Obj⦈" by (auto simp: the_cat_scospan_components)
  show "(gf ∈∘ π’Ÿβˆ˜ (β†’βˆ™β†C⦇Comp⦈)) =
    (βˆƒg f b c a. gf = [g, f]∘ ∧ g : b β†¦β†’βˆ™β†C c ∧ f : a β†¦β†’βˆ™β†C b)"
    for gf
    unfolding the_cat_scospan_Comp_vdomain
  proof
    assume prems: "gf ∈∘ cat_scospan_composable"
    then obtain g f where gf_def: "gf = [g, f]∘" by auto
    from prems show 
      "βˆƒg f b c a. gf = [g, f]∘ ∧ g : b β†¦β†’βˆ™β†C c ∧ f : a β†¦β†’βˆ™β†C b"
      unfolding gf_def
      by (*slow*)
        (
          cases rule: cat_scospan_composableE; 
          (intro exI conjI)?; 
          cs_concl_step?;
          (simp only:)?,
          allβ€Ήintro is_arrI, unfold the_cat_scospan_components(2)β€Ί
        )
        (cs_concl cs_simp: cat_ss_cs_simps V_cs_simps cs_intro: V_cs_intros)+
  next
    assume prems: 
      "βˆƒg f b' c' a'. gf = [g, f]∘ ∧ g : b' β†¦β†’βˆ™β†C c' ∧ f : a' β†¦β†’βˆ™β†C b'"
    then obtain g f b c a
      where gf_def: "gf = [g, f]∘"
        and g: "g : b β†¦β†’βˆ™β†C c"
        and f: "f : a β†¦β†’βˆ™β†C b"
      by clarsimp
    from g f show "gf ∈∘ cat_scospan_composable"
      unfolding gf_def 
      by (elim the_cat_scospan_is_arrE) (auto simp: cat_ss_cs_intros)
  qed
  show "π’Ÿβˆ˜ (β†’βˆ™β†C⦇CId⦈) = β†’βˆ™β†C⦇Obj⦈"
    by (simp add: cat_ss_cs_simps the_cat_scospan_components)
  show "g ∘Aβ†’βˆ™β†C f : a β†¦β†’βˆ™β†C c"
    if "g : b β†¦β†’βˆ™β†C c" and "f : a β†¦β†’βˆ™β†C b" for b c g a f
    using that
    by (elim the_cat_scospan_is_arrE; simp only:)
      (
        allβ€Ή
          solvesβ€Ήsimp add: cat_ss_ineq cat_ss_ineq[symmetric]β€Ί |
          cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros
        β€Ί
      )
  show "h ∘Aβ†’βˆ™β†C g ∘Aβ†’βˆ™β†C f = h ∘Aβ†’βˆ™β†C (g ∘Aβ†’βˆ™β†C f)"
    if "h : c β†¦β†’βˆ™β†C d" and "g : b β†¦β†’βˆ™β†C c" and "f : a β†¦β†’βˆ™β†C b"
    for c d h b g a f
    using that 
    by (elim the_cat_scospan_is_arrE; simp only:) (*slow*)
      (
        allβ€Ή
          solvesβ€Ήsimp only: cat_ss_ineq cat_ss_ineq[symmetric]β€Ί | 
          cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros
          β€Ί
      )
  show "β†’βˆ™β†C⦇CIdβ¦ˆβ¦‡a⦈ : a β†¦β†’βˆ™β†C a" if "a ∈∘ β†’βˆ™β†C⦇Obj⦈" for a
    using that
    by (elim the_cat_scospan_ObjE) 
      (
        allβ€Ή
          cs_concl
            cs_simp: V_cs_simps cat_ss_cs_simps
            cs_intro: V_cs_intros cat_ss_cs_intros
        β€Ί
      )
  show "β†’βˆ™β†C⦇CIdβ¦ˆβ¦‡b⦈ ∘Aβ†’βˆ™β†C f = f" if "f : a β†¦β†’βˆ™β†C b" for a b f
    using that 
    by (elim the_cat_scospan_is_arrE) (*slow*)
      (
        cs_concl 
          cs_simp: V_cs_simps cat_ss_cs_simps 
          cs_intro: V_cs_intros cat_ss_cs_intros
      )+
  show "f ∘Aβ†’βˆ™β†C β†’βˆ™β†C⦇CIdβ¦ˆβ¦‡b⦈ = f" if "f : b β†¦β†’βˆ™β†C c" for b c f
    using that 
    by (elim the_cat_scospan_is_arrE)
      (
        cs_concl
          cs_simp: V_cs_simps cat_ss_cs_simps 
          cs_intro: V_cs_intros cat_ss_cs_intros
      )+
qed 
  (
    cs_concl
      cs_simp: V_cs_simps cat_ss_cs_simps the_cat_scospan_components(1,2) 
      cs_intro: cat_cs_intros cat_ss_cs_intros V_cs_intros 
  )+

lemmas [cat_ss_cs_intros] = 𝒡.finite_category_the_cat_scospan


subsubsectionβ€ΉDuality for β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ίβ€Ί

lemma the_cat_scospan_op[cat_op_simps]: "op_cat (β†’βˆ™β†C) = β†βˆ™β†’C"
proof-
  have dom_lhs: "π’Ÿβˆ˜ (op_cat (β†’βˆ™β†C)) = 6β„•" 
    unfolding op_cat_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (β†βˆ™β†’C) = 6β„•" 
    unfolding the_cat_sspan_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    show "a ∈∘ 6β„• ⟹ op_cat (β†’βˆ™β†C)⦇a⦈ = β†βˆ™β†’C⦇a⦈" for a
    proof
      (
        elim_in_numeral,
        fold dg_field_simps,
        unfold op_cat_components;
        rule sym
      )
      show "β†βˆ™β†’C⦇Comp⦈ = fflip (β†’βˆ™β†C⦇Comp⦈)"
      proof(rule vsv_eqI, unfold cat_ss_cs_simps vdomain_fflip)
        fix gf assume prems: "gf ∈∘ cat_sspan_composable"
        then obtain g f where gf_def: "gf = [g, f]∘" by auto
        from prems have fg: "[f, g]∘ ∈∘ cat_scospan_composable"
          unfolding gf_def by auto
        have [cat_ss_cs_simps]: "g ∘Aβ†βˆ™β†’C f = f ∘Aβ†’βˆ™β†C g"
          if "[f, g]∘ ∈∘ cat_scospan_composable"
          using that
          by (elim cat_scospan_composableE; simp only:)
            (cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros)+
        from fg show 
          "β†βˆ™β†’C⦇Compβ¦ˆβ¦‡gf⦈ = fflip (β†’βˆ™β†C⦇Comp⦈)⦇gf⦈"
          unfolding gf_def by (cs_concl cs_simp: cat_ss_cs_simps fflip_app)
      qed (auto intro: fflip_vsv cat_ss_cs_intros)
    qed (unfold the_cat_sspan_components the_cat_scospan_components, simp_all)
  qed (auto intro: cat_op_intros cat_ss_cs_intros)
qed

lemma (in 𝒡) the_cat_sspan_op[cat_op_simps]: "op_cat (β†βˆ™β†’C) = β†’βˆ™β†C"
proof-
  interpret scospan: finite_category Ξ± β€Ήβ†’βˆ™β†Cβ€Ί 
    by (rule finite_category_the_cat_scospan)
  interpret sspan: finite_category Ξ± β€Ήβ†βˆ™β†’Cβ€Ί
    by (rule scospan.finite_category_op[unfolded cat_op_simps])
  from the_cat_scospan_op have "op_cat (β†βˆ™β†’C) = op_cat (op_cat (β†’βˆ™β†C))" by simp
  also have "… = β†’βˆ™β†C" by (cs_concl cs_simp: cat_op_simps)
  finally show ?thesis by auto
qed

lemmas [cat_op_simps] = 𝒡.the_cat_sspan_op


subsubsectionβ€Ήβ€Ήβ†βˆ™β†’β€Ί is a finite categoryβ€Ί

lemma (in 𝒡) finite_category_the_cat_sspan[cat_ss_cs_intros]:
  "finite_category Ξ± (β†βˆ™β†’C)"
proof-
  interpret scospan: finite_category Ξ± β€Ήβ†’βˆ™β†Cβ€Ί
    by (rule finite_category_the_cat_scospan)
  show ?thesis by (rule scospan.finite_category_op[unfolded cat_op_simps])
qed


subsectionβ€ΉLocal assumptions for functors from β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ίβ€Ί


textβ€Ή
The functors from β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ί are introduced as
convenient abstractions for the definition of the 
pullbacks and the pushouts (e.g., see Chapter III-3 and 
Chapter III-4 in \cite{mac_lane_categories_2010}).
β€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί

locale cf_scospan = category Ξ± β„­ for Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ +
  assumes cf_scospan_𝔀[cat_ss_cs_intros]: "𝔀 : π”ž ↦ℭ 𝔬"
    and cf_scospan_𝔣[cat_ss_cs_intros]: "𝔣 : π”Ÿ ↦ℭ 𝔬"

lemma (in cf_scospan) cf_scospan_𝔀'[cat_ss_cs_intros]:
  assumes "a = π”ž" and "b = 𝔬"
  shows "𝔀 : a ↦ℭ b"
  unfolding assms by (rule cf_scospan_𝔀)

lemma (in cf_scospan) cf_scospan_𝔀''[cat_ss_cs_intros]:
  assumes "g = 𝔀" and "b = 𝔬"
  shows "g : π”ž ↦ℭ b"
  unfolding assms by (rule cf_scospan_𝔀) 

lemma (in cf_scospan) cf_scospan_𝔀'''[cat_ss_cs_intros]:
  assumes "g = 𝔀" and "a = π”ž"
  shows "g : a ↦ℭ 𝔬"
  unfolding assms by (rule cf_scospan_𝔀) 

lemma (in cf_scospan) cf_scospan_𝔣'[cat_ss_cs_intros]:
  assumes "a = π”Ÿ" and "b = 𝔬"
  shows "𝔣 : a ↦ℭ b"
  unfolding assms by (rule cf_scospan_𝔣) 

lemma (in cf_scospan) cf_scospan_𝔣''[cat_ss_cs_intros]:
  assumes "f = 𝔣" and "b = 𝔬"
  shows "f : π”Ÿ ↦ℭ b"
  unfolding assms by (rule cf_scospan_𝔣) 

lemma (in cf_scospan) cf_scospan_𝔣'''[cat_ss_cs_intros]:
  assumes "g = 𝔣" and "b = π”Ÿ"
  shows "g : b ↦ℭ 𝔬"
  unfolding assms by (rule cf_scospan_𝔣) 

locale cf_sspan = category Ξ± β„­ for Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ and β„­ +
  assumes cf_sspan_𝔀[cat_ss_cs_intros]: "𝔀 : 𝔬 ↦ℭ π”ž"
    and cf_sspan_𝔣[cat_ss_cs_intros]: "𝔣 : 𝔬 ↦ℭ π”Ÿ"

lemma (in cf_sspan) cf_sspan_𝔀'[cat_ss_cs_intros]:
  assumes "a = 𝔬" and "b = π”ž"
  shows "𝔀 : a ↦ℭ b"
  unfolding assms by (rule cf_sspan_𝔀) 

lemma (in cf_sspan) cf_sspan_𝔀''[cat_ss_cs_intros]:
  assumes "g = 𝔀" and "a = π”ž"
  shows "g : 𝔬 ↦ℭ a"
  unfolding assms by (rule cf_sspan_𝔀) 

lemma (in cf_sspan) cf_sspan_𝔀'''[cat_ss_cs_intros]:
  assumes "g = 𝔀" and "a = 𝔬"
  shows "g : a ↦ℭ π”ž"
  unfolding assms by (rule cf_sspan_𝔀) 

lemma (in cf_sspan) cf_sspan_𝔣'[cat_ss_cs_intros]:
  assumes "a = 𝔬" and "b = π”Ÿ"
  shows "𝔣 : a ↦ℭ b"
  unfolding assms by (rule cf_sspan_𝔣) 

lemma (in cf_sspan) cf_sspan_𝔣''[cat_ss_cs_intros]:
  assumes "f = 𝔣" and "b = π”Ÿ"
  shows "f : 𝔬 ↦ℭ b"
  unfolding assms by (rule cf_sspan_𝔣) 

lemma (in cf_sspan) cf_sspan_𝔣'''[cat_ss_cs_intros]:
  assumes "f = 𝔣" and "b = 𝔬"
  shows "f : b ↦ℭ π”Ÿ"
  unfolding assms by (rule cf_sspan_𝔣) 


textβ€ΉRules.β€Ί

lemmas (in cf_scospan) [cat_ss_cs_intros] = cf_scospan_axioms

mk_ide rf cf_scospan_def[unfolded cf_scospan_axioms_def]
  |intro cf_scospanI|
  |dest cf_scospanD[dest]|
  |elim cf_scospanE[elim]|

lemmas [cat_ss_cs_intros] = cf_scospanD(1)

lemmas (in cf_sspan) [cat_ss_cs_intros] = cf_sspan_axioms

mk_ide rf cf_sspan_def[unfolded cf_sspan_axioms_def]
  |intro cf_sspanI|
  |dest cf_sspanD[dest]|
  |elim cf_sspanE[elim]|


textβ€ΉDuality.β€Ί

lemma (in cf_scospan) cf_sspan_op[cat_op_intros]: 
  "cf_sspan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ (op_cat β„­)"
  by (intro cf_sspanI, unfold cat_op_simps)
    (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_ss_cs_intros)+ 

lemmas [cat_op_intros] = cf_scospan.cf_sspan_op

lemma (in cf_sspan) cf_scospan_op[cat_op_intros]: 
  "cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ (op_cat β„­)"
  by (intro cf_scospanI, unfold cat_op_simps)
    (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_ss_cs_intros)+ 

lemmas [cat_op_intros] = cf_sspan.cf_scospan_op



subsectionβ€ΉFunctors from β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition the_cf_scospan :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V" 
  (β€ΉβŸ¨_β†’_β†’_←_←_⟩CFΔ±β€Ί [51, 51, 51, 51, 51] 999)
  where "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ =
    [
      (
        Ξ»aβˆˆβˆ˜β†’βˆ™β†C⦇Obj⦈.
         if a = π”žSS β‡’ π”ž
          | a = π”ŸSS β‡’ π”Ÿ
          | otherwise β‡’ 𝔬
      ),
      (
        Ξ»fβˆˆβˆ˜β†’βˆ™β†C⦇Arr⦈.
         if f = π”žSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”žβ¦ˆ
          | f = π”ŸSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”Ÿβ¦ˆ
          | f = 𝔀SS β‡’ 𝔀
          | f = 𝔣SS β‡’ 𝔣
          | otherwise β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”¬β¦ˆ
      ),
      β†’βˆ™β†C,
      β„­
    ]∘"

definition the_cf_sspan :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V" 
  (β€ΉβŸ¨_←_←_β†’_β†’_⟩CFΔ±β€Ί [51, 51, 51, 51, 51] 999)
  where "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­ =
    [
      (
        Ξ»aβˆˆβˆ˜β†βˆ™β†’C⦇Obj⦈.
         if a = π”žSS β‡’ π”ž
          | a = π”ŸSS β‡’ π”Ÿ
          | otherwise β‡’ 𝔬
      ),
      (
        Ξ»fβˆˆβˆ˜β†βˆ™β†’C⦇Arr⦈.
         if f = π”žSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”žβ¦ˆ
          | f = π”ŸSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”Ÿβ¦ˆ
          | f = 𝔀SS β‡’ 𝔀
          | f = 𝔣SS β‡’ 𝔣
          | otherwise β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”¬β¦ˆ
      ),
      β†βˆ™β†’C,
      β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma the_cf_scospan_components:
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMap⦈ =
    (
      Ξ»aβˆˆβˆ˜β†’βˆ™β†C⦇Obj⦈.
       if a = π”žSS β‡’ π”ž
        | a = π”ŸSS β‡’ π”Ÿ
        | otherwise β‡’ 𝔬
    )"
    and "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMap⦈ =
      (
        Ξ»fβˆˆβˆ˜β†’βˆ™β†C⦇Arr⦈.
         if f = π”žSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”žβ¦ˆ
          | f = π”ŸSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”Ÿβ¦ˆ
          | f = 𝔀SS β‡’ 𝔀
          | f = 𝔣SS β‡’ 𝔣
          | otherwise β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”¬β¦ˆ
      )"
    and [cat_ss_cs_simps]: "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇HomDom⦈ = β†’βˆ™β†C"
    and [cat_ss_cs_simps]: "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇HomCod⦈ = β„­"
  unfolding the_cf_scospan_def dghm_field_simps by (simp_all add: nat_omega_simps)

lemma the_cf_sspan_components:
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ObjMap⦈ =
    (
      Ξ»aβˆˆβˆ˜β†βˆ™β†’C⦇Obj⦈.
       if a = π”žSS β‡’ π”ž
        | a = π”ŸSS β‡’ π”Ÿ
        | otherwise β‡’ 𝔬
    )"
    and "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMap⦈ =
      (
        Ξ»fβˆˆβˆ˜β†βˆ™β†’C⦇Arr⦈.
         if f = π”žSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”žβ¦ˆ
          | f = π”ŸSS β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”Ÿβ¦ˆ
          | f = 𝔀SS β‡’ 𝔀
          | f = 𝔣SS β‡’ 𝔣
          | otherwise β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”¬β¦ˆ
      )"
    and [cat_ss_cs_simps]: "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇HomDom⦈ = β†βˆ™β†’C"
    and [cat_ss_cs_simps]: "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇HomCod⦈ = β„­"
  unfolding the_cf_sspan_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


textβ€ΉElementary properties.β€Ί

lemma the_cf_scospan_components_vsv[cat_ss_cs_intros]: "vsv (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­)"
  unfolding the_cf_scospan_def by auto

lemma the_cf_sspan_components_vsv[cat_ss_cs_intros]: "vsv (βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­)"
  unfolding the_cf_sspan_def by auto


subsubsectionβ€ΉObject map.β€Ί

mk_VLambda the_cf_scospan_components(1)
  |vsv the_cf_scospan_ObjMap_vsv[cat_ss_cs_intros]|
  |vdomain the_cf_scospan_ObjMap_vdomain[cat_ss_cs_simps]|
  |app the_cf_scospan_ObjMap_app|

lemma the_cf_scospan_ObjMap_app_π”ž[cat_ss_cs_simps]:
  assumes "x = π”žSS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡x⦈ = π”ž"
  by 
    (
      cs_concl 
        cs_simp: the_cf_scospan_ObjMap_app V_cs_simps assms
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ObjMap_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "x = π”ŸSS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡x⦈ = π”Ÿ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_scospan_ObjMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ObjMap_app_𝔬[cat_ss_cs_simps]:
  assumes "x = 𝔬SS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡x⦈ = 𝔬"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_scospan_ObjMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ObjMap_vrange:
  "β„›βˆ˜ (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
proof
  (
    intro vsv.vsv_vrange_vsubset, 
    unfold the_cf_scospan_ObjMap_vdomain, 
    intro the_cf_scospan_ObjMap_vsv
  )
  fix a assume "a ∈∘ β†’βˆ™β†C⦇Obj⦈"
  then consider β€Ήa = π”žSSβ€Ί | β€Ήa = π”ŸSSβ€Ί | β€Ήa = 𝔬SSβ€Ί 
    unfolding the_cat_scospan_components by auto
  then show "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡a⦈ ∈∘ ℭ⦇Obj⦈"
    by cases 
      (
        cs_concl
          cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
      )+
qed

mk_VLambda the_cf_sspan_components(1)
  |vsv the_cf_sspan_ObjMap_vsv[cat_ss_cs_intros]|
  |vdomain the_cf_sspan_ObjMap_vdomain[cat_ss_cs_simps]|
  |app the_cf_sspan_ObjMap_app|

lemma the_cf_sspan_ObjMap_app_π”ž[cat_ss_cs_simps]:
  assumes "x = π”žSS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡x⦈ = π”ž"
  by 
    (
      cs_concl 
        cs_simp: the_cf_sspan_ObjMap_app V_cs_simps assms
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ObjMap_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "x = π”ŸSS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡x⦈ = π”Ÿ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_sspan_ObjMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ObjMap_app_𝔬[cat_ss_cs_simps]:
  assumes "x = 𝔬SS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡x⦈ = 𝔬"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_sspan_ObjMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ObjMap_vrange:
  "β„›βˆ˜ (βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
proof
  (
    intro vsv.vsv_vrange_vsubset, 
    unfold the_cf_sspan_ObjMap_vdomain, 
    intro the_cf_sspan_ObjMap_vsv
  )
  fix a assume "a ∈∘ β†βˆ™β†’C⦇Obj⦈"
  then consider β€Ήa = π”žSSβ€Ί | β€Ήa = π”ŸSSβ€Ί | β€Ήa = 𝔬SSβ€Ί 
    unfolding the_cat_sspan_components by auto
  then show "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡a⦈ ∈∘ ℭ⦇Obj⦈"
    by cases 
      (
        cs_concl 
          cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
      )+
qed


subsubsectionβ€ΉArrow map.β€Ί

mk_VLambda the_cf_scospan_components(2)
  |vsv the_cf_scospan_ArrMap_vsv[cat_ss_cs_intros]|
  |vdomain the_cf_scospan_ArrMap_vdomain[cat_ss_cs_simps]|
  |app the_cf_scospan_ArrMap_app|

lemma (in cf_scospan) the_cf_scospan_ArrMap_app_𝔬[cat_ss_cs_simps]:
  assumes "f = 𝔬SS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”¬β¦ˆ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ArrMap_app_π”ž[cat_ss_cs_simps]:
  assumes "f = π”žSS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”žβ¦ˆ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ArrMap_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "f = π”ŸSS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”Ÿβ¦ˆ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ArrMap_app_𝔀[cat_ss_cs_simps]:
  assumes "f = 𝔀SS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔀"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ArrMap_app_𝔣[cat_ss_cs_simps]:
  assumes "f = 𝔣SS"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔣"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_scospan) the_cf_scospan_ArrMap_vrange:
  "β„›βˆ˜ (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof
  (
    intro vsv.vsv_vrange_vsubset, 
    unfold the_cf_scospan_ArrMap_vdomain, 
    intro the_cf_scospan_ArrMap_vsv
  )
  fix a assume "a ∈∘ β†’βˆ™β†C⦇Arr⦈"
  then consider β€Ήa = π”žSSβ€Ί | β€Ήa = π”ŸSSβ€Ί | β€Ήa = 𝔬SSβ€Ί | β€Ήa = 𝔀SSβ€Ί | β€Ήa = 𝔣SSβ€Ί 
    unfolding the_cat_scospan_components by auto
  then show "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡a⦈ ∈∘ ℭ⦇Arr⦈"
    by cases 
      (
        cs_concl 
          cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
      )+
qed

mk_VLambda the_cf_sspan_components(2)
  |vsv the_cf_sspan_ArrMap_vsv[cat_ss_cs_intros]|
  |vdomain the_cf_sspan_ArrMap_vdomain[cat_ss_cs_simps]|
  |app the_cf_sspan_ArrMap_app|

lemma (in cf_sspan) the_cf_sspan_ArrMap_app_𝔬[cat_ss_cs_simps]:
  assumes "f = 𝔬SS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”¬β¦ˆ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ArrMap_app_π”ž[cat_ss_cs_simps]:
  assumes "f = π”žSS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”žβ¦ˆ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ArrMap_app_π”Ÿ[cat_ss_cs_simps]:
  assumes "f = π”ŸSS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”Ÿβ¦ˆ"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ArrMap_app_𝔀[cat_ss_cs_simps]:
  assumes "f = 𝔀SS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔀"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ArrMap_app_𝔣[cat_ss_cs_simps]:
  assumes "f = 𝔣SS"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔣"
  using cat_ss_ineq
  by 
    (
      cs_concl 
        cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms 
        cs_intro: cat_ss_cs_intros
    )

lemma (in cf_sspan) the_cf_sspan_ArrMap_vrange:
  "β„›βˆ˜ (βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof
  (
    intro vsv.vsv_vrange_vsubset,
    unfold the_cf_sspan_ArrMap_vdomain,
    intro the_cf_sspan_ArrMap_vsv
  )
  fix a assume "a ∈∘ β†βˆ™β†’C⦇Arr⦈"
  then consider β€Ήa = π”žSSβ€Ί | β€Ήa = π”ŸSSβ€Ί | β€Ήa = 𝔬SSβ€Ί | β€Ήa = 𝔀SSβ€Ί | β€Ήa = 𝔣SSβ€Ί 
    unfolding the_cat_sspan_components by auto
  then show "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡a⦈ ∈∘ ℭ⦇Arr⦈"
    by cases
      (
        cs_concl
          cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
      )+
qed


subsubsectionβ€ΉFunctor from β€Ήβ†’βˆ™β†β€Ί is a functorβ€Ί

lemma (in cf_scospan) cf_scospan_the_cf_scospan_is_tm_functor:
  "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦C.tmΞ± β„­"
proof(intro is_functor.cf_is_tm_functor_if_HomDom_finite_category is_functorI')
  show "vfsequence (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­)" 
    unfolding the_cf_scospan_def by auto
  show "vcard (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­) = 4β„•"
    unfolding the_cf_scospan_def by (simp add: nat_omega_simps)
  show "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈ :
    βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "f : a β†¦β†’βˆ™β†C b" for a b f
    using that
    by (cases rule: the_cat_scospan_is_arrE; simp only:)
      (
        cs_concl 
          cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
      )+
  show "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡g ∘Aβ†’βˆ™β†C f⦈ =
    βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­ βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡f⦈"
    if "g : b β†¦β†’βˆ™β†C c" and "f : a β†¦β†’βˆ™β†C b" for b c g a f
    using that
    by (elim the_cat_scospan_is_arrE) (*very slow*)
      (
        allβ€Ήsimp only:β€Ί, 
        allβ€Ή
          solvesβ€Ήsimp add: cat_ss_ineq cat_ss_ineq[symmetric]β€Ί | 
          cs_concl 
            cs_simp: cat_cs_simps cat_ss_cs_simps 
            cs_intro: cat_cs_intros cat_ss_cs_intros
          β€Ί
      )
  show 
    "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ArrMapβ¦ˆβ¦‡β†’βˆ™β†C⦇CIdβ¦ˆβ¦‡c⦈⦈ =
      ℭ⦇CIdβ¦ˆβ¦‡βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFℭ⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
    if "c ∈∘ β†’βˆ™β†C⦇Obj⦈" for c
    using that
    by (elim the_cat_scospan_ObjE; simp only:)
      (
        cs_concl
          cs_simp: V_cs_simps cat_ss_cs_simps 
          cs_intro: V_cs_intros cat_ss_cs_intros
      )+

qed
  (
    cs_concl
      cs_simp: cat_ss_cs_simps
      cs_intro: 
        the_cf_scospan_ObjMap_vrange
        cat_ss_cs_intros cat_cs_intros cat_small_cs_intros
  )+

lemma (in cf_scospan) cf_scospan_the_cf_scospan_is_tm_functor':
  assumes "𝔄' = β†’βˆ™β†C" and "β„­' = β„­"
  shows "βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : 𝔄' ↦↦C.tmΞ± β„­'"
  unfolding assms by (rule cf_scospan_the_cf_scospan_is_tm_functor)

lemmas [cat_ss_cs_intros] = cf_scospan.cf_scospan_the_cf_scospan_is_tm_functor


subsubsectionβ€ΉDuality for the functors from β€Ήβ†’βˆ™β†β€Ί and β€Ήβ†βˆ™β†’β€Ίβ€Ί

lemma op_cf_cf_scospan[cat_op_simps]: 
  "op_cf (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­) = βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFop_cat β„­"
proof-
  have dom_lhs: "π’Ÿβˆ˜ (op_cf (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­)) = 4β„•" 
    unfolding op_cf_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFop_cat β„­) = 4β„•" 
    unfolding the_cf_sspan_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    show "op_cf (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­)⦇a⦈ = βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFop_cat ℭ⦇a⦈"
      if "a ∈∘ 4β„•" for a
      using that
      by 
        (
          elim_in_numeral, 
          fold dghm_field_simps, 
          unfold cat_op_simps the_cf_sspan_components the_cf_scospan_components
        )
        (
          simp_all add: 
            the_cat_scospan_components(1,2)
            the_cat_sspan_components(1,2)
            cat_op_simps
        )
  qed (auto intro: cat_op_intros cat_ss_cs_intros)
qed

lemma (in 𝒡) op_cf_cf_scospan[cat_op_simps]: 
  "op_cf (βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­) = βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFop_cat β„­"
proof-
  have dom_lhs: "π’Ÿβˆ˜ (op_cf (βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­)) = 4β„•" 
    unfolding op_cf_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFop_cat β„­) = 4β„•" 
    unfolding the_cf_scospan_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    show "op_cf (βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­)⦇a⦈ = βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFop_cat ℭ⦇a⦈"
      if "a ∈∘ 4β„•" for a
      using that
      by 
        (
          elim_in_numeral, 
          fold dghm_field_simps, 
          unfold cat_op_simps the_cf_sspan_components the_cf_scospan_components
        )
        (
          simp_all add: 
            the_cat_scospan_components(1,2)
            the_cat_sspan_components(1,2)
            cat_op_simps
        )
  qed (auto intro: cat_op_intros cat_ss_cs_intros)
qed

lemmas [cat_op_simps] = 𝒡.op_cf_cf_scospan


subsubsectionβ€ΉFunctor from β€Ήβ†βˆ™β†’β€Ί is a functorβ€Ί

lemma (in cf_sspan) cf_sspan_the_cf_sspan_is_tm_functor:
  "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­ : β†βˆ™β†’C ↦↦C.tmΞ± β„­"
proof-
  interpret scospan: cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β€Ήop_cat β„­β€Ί by (rule cf_scospan_op)
  interpret scospan:
    is_tm_functor Ξ± β€Ήβ†’βˆ™β†Cβ€Ί β€Ήop_cat β„­β€Ί β€ΉβŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFop_cat β„­β€Ί
    by (rule scospan.cf_scospan_the_cf_scospan_is_tm_functor)
  show ?thesis by (rule scospan.is_tm_functor_op[unfolded cat_op_simps])
qed

lemma (in cf_sspan) cf_sspan_the_cf_sspan_is_tm_functor':
  assumes "𝔄' = β†βˆ™β†’C" and "β„­' = β„­"
  shows "βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­ : 𝔄' ↦↦C.tmΞ± β„­'"
  unfolding assms by (rule cf_sspan_the_cf_sspan_is_tm_functor)

lemmas [cat_ss_cs_intros] = cf_sspan.cf_sspan_the_cf_sspan_is_tm_functor

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Parallel

(* Copyright 2021 (C) Mihails Milehins *)

section‹‹↑↑›: category with parallel arrows between two objectsβ€Ί
theory CZH_ECAT_Parallel
  imports CZH_ECAT_Small_Functor
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems cat_parallel_cs_simps
named_theorems cat_parallel_cs_intros

named_theorems cat_parallel_elem_simps

definition π”žPL where [cat_parallel_elem_simps]: "π”žPL = 1β„•"
definition π”ŸPL where [cat_parallel_elem_simps]: "π”ŸPL = 2β„•"
definition 𝔀PL where [cat_parallel_elem_simps]: "𝔀PL = 3β„•"
definition 𝔣PL where [cat_parallel_elem_simps]: "𝔣PL = 4β„•"

lemma cat_PL_ineq:
  shows cat_PL_π”žπ”Ÿ[cat_parallel_cs_intros]: "π”žPL β‰  π”ŸPL"
    and cat_PL_π”žπ”€[cat_parallel_cs_intros]: "π”žPL β‰  𝔀PL"
    and cat_PL_π”žπ”£[cat_parallel_cs_intros]: "π”žPL β‰  𝔣PL"
    and cat_PL_π”Ÿπ”€[cat_parallel_cs_intros]: "π”ŸPL β‰  𝔀PL"
    and cat_PL_π”Ÿπ”£[cat_parallel_cs_intros]: "π”ŸPL β‰  𝔣PL"
    and cat_PL_𝔀𝔣[cat_parallel_cs_intros]: "𝔀PL β‰  𝔣PL"
  unfolding cat_parallel_elem_simps by simp_all

lemma (in 𝒡) 
  shows cat_PL_π”ž[cat_parallel_cs_intros]: "π”žPL ∈∘ Vset Ξ±"
    and cat_PL_π”Ÿ[cat_parallel_cs_intros]: "π”ŸPL ∈∘ Vset Ξ±"
    and cat_PL_𝔀[cat_parallel_cs_intros]: "𝔀PL ∈∘ Vset Ξ±"
    and cat_PL_𝔣[cat_parallel_cs_intros]: "𝔣PL ∈∘ Vset Ξ±"
  unfolding cat_parallel_elem_simps by simp_all



subsectionβ€ΉComposable arrowsβ€Ί

abbreviation cat_parallel_composable :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣 ≑
    (set {π”Ÿ} Γ—βˆ™ set {π”Ÿ, 𝔀, 𝔣}) βˆͺ∘ (set {π”ž, 𝔀, 𝔣} Γ—βˆ™ set {π”ž})"


textβ€ΉRules.β€Ί

lemma cat_parallel_composable_π”žπ”ž[cat_parallel_cs_intros]:
  assumes "g = π”ž" and "f = π”ž"
  shows "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
  unfolding assms by auto

lemma cat_parallel_composable_π”žπ”€[cat_parallel_cs_intros]:
  assumes "g = π”Ÿ" and "f = 𝔀"
  shows "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
  unfolding assms by auto

lemma cat_parallel_composable_π”žπ”£[cat_parallel_cs_intros]:
  assumes "g = π”Ÿ" and "f = 𝔣"
  shows "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
  unfolding assms by auto

lemma cat_parallel_composable_π”€π”ž[cat_parallel_cs_intros]:
  assumes "g = 𝔀" and "f = π”ž"
  shows "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
  unfolding assms by auto

lemma cat_parallel_composable_π”£π”ž[cat_parallel_cs_intros]:
  assumes "g = 𝔣" and "f = π”ž"
  shows "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
  unfolding assms by auto

lemma cat_parallel_composable_π”Ÿπ”Ÿ[cat_parallel_cs_intros]:
  assumes "g = π”Ÿ" and "f = π”Ÿ"
  shows "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
  unfolding assms by auto

lemma cat_parallel_composableE:
  assumes "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
  obtains "g = π”Ÿ" and "f = π”Ÿ"
        | "g = π”Ÿ" and "f = 𝔀" 
        | "g = π”Ÿ" and "f = 𝔣"
        | "g = 𝔀" and "f = π”ž"
        | "g = 𝔣" and "f = π”ž"
        | "g = π”ž" and "f = π”ž"
  using assms that by auto


textβ€ΉElementary properties.β€Ί

lemma cat_parallel_composable_fconverse: 
  "(cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣)Β―βˆ™ = cat_parallel_composable π”Ÿ π”ž 𝔣 𝔀"
  by auto



subsectionβ€Ή
Local assumptions for a category with parallel arrows between two objects
β€Ί

locale cat_parallel = 𝒡 Ξ± for Ξ± +  
  fixes π”ž π”Ÿ 𝔀 𝔣
  assumes cat_parallel_π”žπ”Ÿ[cat_parallel_cs_intros]: "π”ž β‰  π”Ÿ"
    and cat_parallel_π”žπ”€[cat_parallel_cs_intros]: "π”ž β‰  𝔀"
    and cat_parallel_π”žπ”£[cat_parallel_cs_intros]: "π”ž β‰  𝔣"
    and cat_parallel_π”Ÿπ”€[cat_parallel_cs_intros]: "π”Ÿ β‰  𝔀"
    and cat_parallel_π”Ÿπ”£[cat_parallel_cs_intros]: "π”Ÿ β‰  𝔣"
    and cat_parallel_𝔀𝔣[cat_parallel_cs_intros]: "𝔀 β‰  𝔣"
    and cat_parallel_π”ž_in_Vset[cat_parallel_cs_intros]: "π”ž ∈∘ Vset Ξ±"
    and cat_parallel_π”Ÿ_in_Vset[cat_parallel_cs_intros]: "π”Ÿ ∈∘ Vset Ξ±"
    and cat_parallel_𝔀_in_Vset[cat_parallel_cs_intros]: "𝔀 ∈∘ Vset Ξ±"
    and cat_parallel_𝔣_in_Vset[cat_parallel_cs_intros]: "𝔣 ∈∘ Vset Ξ±"

lemmas (in cat_parallel) cat_parallel_ineq =
  cat_parallel_π”žπ”Ÿ
  cat_parallel_π”žπ”€
  cat_parallel_π”žπ”£
  cat_parallel_π”Ÿπ”€
  cat_parallel_π”Ÿπ”£
  cat_parallel_𝔀𝔣 


textβ€ΉRules.β€Ί

lemmas (in cat_parallel) [cat_parallel_cs_intros] = cat_parallel_axioms

mk_ide rf cat_parallel_def[unfolded cat_parallel_axioms_def]
  |intro cat_parallelI|
  |dest cat_parallelD[dest]|
  |elim cat_parallelE[elim]|


textβ€ΉDuality.β€Ί

lemma (in cat_parallel) cat_parallel_op[cat_op_intros]: 
  "cat_parallel Ξ± π”Ÿ π”ž 𝔣 𝔀"
  by (intro cat_parallelI) 
    (auto intro!: cat_parallel_cs_intros cat_parallel_ineq[symmetric])



subsection‹‹↑↑›: category with parallel arrows between two objectsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter I-2 and Chapter III-3 in \cite{mac_lane_categories_2010}.β€Ί

definition the_cat_parallel :: "V β‡’ V β‡’ V β‡’ V β‡’ V" (‹↑↑Cβ€Ί)
  where "↑↑C π”ž π”Ÿ 𝔀 𝔣 =
    [
      set {π”ž, π”Ÿ},
      set {π”ž, π”Ÿ, 𝔀, 𝔣},
      (Ξ»x∈∘set {π”ž, π”Ÿ, 𝔀, 𝔣}. (x = π”Ÿ ? π”Ÿ : π”ž)),
      (Ξ»x∈∘set {π”ž, π”Ÿ, 𝔀, 𝔣}. (x = π”ž ? π”ž : π”Ÿ)),
      (
        Ξ»gf∈∘cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣.
         if gf = [π”Ÿ, π”Ÿ]∘ β‡’ π”Ÿ
          | gf = [π”Ÿ, 𝔀]∘ β‡’ 𝔀
          | gf = [π”Ÿ, 𝔣]∘ β‡’ 𝔣
          | gf = [𝔀, π”ž]∘ β‡’ 𝔀
          | gf = [𝔣, π”ž]∘ β‡’ 𝔣
          | otherwise β‡’ π”ž
      ),
      vid_on (set {π”ž, π”Ÿ})
    ]∘"


textβ€ΉComponents.β€Ί

lemma the_cat_parallel_components: 
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈ = set {π”ž, π”Ÿ}"
    and "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈ = set {π”ž, π”Ÿ, 𝔀, 𝔣}"
    and "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Dom⦈ = (Ξ»x∈∘set {π”ž, π”Ÿ, 𝔀, 𝔣}. (x = π”Ÿ ? π”Ÿ : π”ž))"
    and "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Cod⦈ = (Ξ»x∈∘set {π”ž, π”Ÿ, 𝔀, 𝔣}. (x = π”ž ? π”ž : π”Ÿ))"
    and "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Comp⦈ =
      (
        Ξ»gf∈∘cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣.
         if gf = [π”Ÿ, π”Ÿ]∘ β‡’ π”Ÿ
          | gf = [π”Ÿ, 𝔀]∘ β‡’ 𝔀
          | gf = [π”Ÿ, 𝔣]∘ β‡’ 𝔣
          | gf = [𝔀, π”ž]∘ β‡’ 𝔀
          | gf = [𝔣, π”ž]∘ β‡’ 𝔣
          | otherwise β‡’ π”ž
      )"
    and "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CId⦈ = vid_on (set {π”ž, π”Ÿ})"
  unfolding the_cat_parallel_def dg_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObjectsβ€Ί

lemma the_cat_parallel_Obj_π”žI[cat_parallel_cs_intros]:
  assumes "a = π”ž"
  shows "a ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈"
  using assms unfolding the_cat_parallel_components by simp

lemma the_cat_parallel_Obj_π”ŸI[cat_parallel_cs_intros]:
  assumes "a = π”Ÿ"
  shows "a ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈"
  using assms unfolding the_cat_parallel_components by simp

lemma the_cat_parallel_ObjE:
  assumes "a ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈"
  obtains "a = π”ž" | "a = π”Ÿ" 
  using assms unfolding the_cat_parallel_components(1) by fastforce


subsubsectionβ€ΉArrowsβ€Ί

lemma the_cat_parallel_Arr_π”žI[cat_parallel_cs_intros]:
  assumes "f = π”ž"  
  shows "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
  using assms unfolding the_cat_parallel_components by simp

lemma the_cat_parallel_Arr_π”ŸI[cat_parallel_cs_intros]:
  assumes "f = π”Ÿ"  
  shows "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
  using assms unfolding the_cat_parallel_components by simp

lemma the_cat_parallel_Arr_𝔀I[cat_parallel_cs_intros]:
  assumes "f = 𝔀"
  shows "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
  using assms unfolding the_cat_parallel_components by simp

lemma the_cat_parallel_Arr_𝔣I[cat_parallel_cs_intros]:
  assumes "f = 𝔣"
  shows "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
  using assms unfolding the_cat_parallel_components by simp

lemma the_cat_parallel_ArrE:
  assumes "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
  obtains "f = π”ž" | "f = π”Ÿ" | "f = 𝔀" | "f = 𝔣" 
  using assms that unfolding the_cat_parallel_components by auto


subsubsectionβ€ΉDomainβ€Ί

mk_VLambda the_cat_parallel_components(3)
  |vsv the_cat_parallel_Dom_vsv[cat_parallel_cs_intros]|
  |vdomain the_cat_parallel_Dom_vdomain[cat_parallel_cs_simps]|

lemma (in cat_parallel) the_cat_parallel_Dom_app_π”Ÿ[cat_parallel_cs_simps]:
  assumes "f = π”Ÿ"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡f⦈ = π”Ÿ"
  unfolding the_cat_parallel_components assms by simp

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_π”Ÿ

lemma (in cat_parallel) the_cat_parallel_Dom_app_𝔀[cat_parallel_cs_simps]:
  assumes "f = 𝔀"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡f⦈ = π”ž"
  unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_𝔀

lemma (in cat_parallel) the_cat_parallel_Dom_app_𝔣[cat_parallel_cs_simps]:
  assumes "f = 𝔣"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡f⦈ = π”ž"
  unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_𝔣

lemma (in cat_parallel) the_cat_parallel_Dom_app_π”ž[cat_parallel_cs_simps]:
  assumes "f = π”ž"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡f⦈ = π”ž"
  unfolding the_cat_parallel_components assms by auto

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_π”ž


subsubsectionβ€ΉCodomainβ€Ί

mk_VLambda the_cat_parallel_components(4)
  |vsv the_cat_parallel_Cod_vsv[cat_parallel_cs_intros]|
  |vdomain the_cat_parallel_Cod_vdomain[cat_parallel_cs_simps]|

lemma (in cat_parallel) the_cat_parallel_Cod_app_π”Ÿ[cat_parallel_cs_simps]:
  assumes "f = π”Ÿ"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡f⦈ = π”Ÿ"
  unfolding the_cat_parallel_components assms by simp

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_π”Ÿ

lemma (in cat_parallel) the_cat_parallel_Cod_app_𝔀[cat_parallel_cs_simps]:
  assumes "f = 𝔀"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡f⦈ = π”Ÿ"
  unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_𝔀

lemma (in cat_parallel) the_cat_parallel_Cod_app_𝔣[cat_parallel_cs_simps]:
  assumes "f = 𝔣"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡f⦈ = π”Ÿ"
  unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_𝔣

lemma (in cat_parallel) the_cat_parallel_Cod_app_π”ž[cat_parallel_cs_simps]:
  assumes "f = π”ž"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡f⦈ = π”ž"
  unfolding the_cat_parallel_components assms by auto

lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_π”ž


subsubsectionβ€ΉCompositionβ€Ί

mk_VLambda the_cat_parallel_components(5)
  |vsv the_cat_parallel_Comp_vsv[cat_parallel_cs_intros]|
  |vdomain the_cat_parallel_Comp_vdomain[cat_parallel_cs_simps]|
  |app the_cat_parallel_Comp_app[cat_parallel_cs_simps]|

lemma the_cat_parallel_Comp_app_π”Ÿπ”Ÿ[cat_parallel_cs_simps]:
  assumes "g = π”Ÿ" and "f = π”Ÿ"
  shows "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g" "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
    by (cs_concl cs_intro: cat_parallel_cs_intros)
  then show "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g" "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f"
    unfolding the_cat_parallel_components(5) assms 
    by (auto simp: nat_omega_simps)
qed

lemma the_cat_parallel_Comp_app_π”žπ”ž[cat_parallel_cs_simps]:
  assumes "g = π”ž" and "f = π”ž"
  shows "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g" "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f"
proof-
  from assms have "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
    by (cs_concl cs_intro: cat_parallel_cs_intros)
  then show "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g" "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f"
    unfolding the_cat_parallel_components(5) assms 
    by (auto simp: nat_omega_simps)
qed

lemma the_cat_parallel_Comp_app_π”Ÿπ”€[cat_parallel_cs_simps]:
  assumes "g = π”Ÿ" and "f = 𝔀"
  shows "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
    by (cs_concl cs_intro: cat_parallel_cs_intros)
  then show "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f"
    unfolding the_cat_parallel_components(5) assms 
    by (auto simp: nat_omega_simps)
qed

lemma the_cat_parallel_Comp_app_π”Ÿπ”£[cat_parallel_cs_simps]:
  assumes "g = π”Ÿ" and "f = 𝔣"
  shows "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
    by (cs_concl cs_intro: cat_parallel_cs_intros)
  then show "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f"
    unfolding the_cat_parallel_components(5) assms 
    by (auto simp: nat_omega_simps)
qed

lemma (in cat_parallel) the_cat_parallel_Comp_app_π”€π”ž[cat_parallel_cs_simps]:
  assumes "g = 𝔀" and "f = π”ž"
  shows "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
    by (cs_concl cs_intro: cat_parallel_cs_intros)
  then show "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g"
    unfolding the_cat_parallel_components(5) assms 
    using cat_parallel_ineq
    by (auto simp: nat_omega_simps)
qed

lemma (in cat_parallel) the_cat_parallel_Comp_app_π”£π”ž[cat_parallel_cs_simps]:
  assumes "g = 𝔣" and "f = π”ž"
  shows "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g" 
proof-
  from assms have "[g, f]∘ ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
    by (cs_concl cs_intro: cat_parallel_cs_intros)
  then show "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = g"
    unfolding the_cat_parallel_components(5) assms 
    using cat_parallel_ineq
    by (auto simp: nat_omega_simps)
qed


subsubsectionβ€ΉIdentityβ€Ί

mk_VLambda the_cat_parallel_components(6)[unfolded VLambda_vid_on[symmetric]]
  |vsv the_cat_parallel_CId_vsv[cat_parallel_cs_intros]|
  |vdomain the_cat_parallel_CId_vdomain[cat_parallel_cs_simps]|
  |app the_cat_parallel_CId_app|

lemma the_cat_parallel_CId_app_π”ž[cat_parallel_cs_simps]: 
  assumes "a = π”ž"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡a⦈ = π”ž"
  unfolding assms by (auto simp: the_cat_parallel_CId_app)

lemma the_cat_parallel_CId_app_π”Ÿ[cat_parallel_cs_simps]: 
  assumes "a = π”Ÿ"
  shows "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡a⦈ = π”Ÿ"
  unfolding assms by (auto simp: the_cat_parallel_CId_app)


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma (in cat_parallel) the_cat_parallel_is_arr_π”žπ”žπ”ž[cat_parallel_cs_intros]:
  assumes "a' = π”ž" and "b' = π”ž" and "f = π”ž"
  shows "f : a' ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b'"
proof(intro is_arrI, unfold assms)
  show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡π”žβ¦ˆ = π”ž" "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡π”žβ¦ˆ = π”ž"
    by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components)

lemma (in cat_parallel) the_cat_parallel_is_arr_π”Ÿπ”Ÿπ”Ÿ[cat_parallel_cs_intros]:
  assumes "a' = π”Ÿ" and "b' = π”Ÿ" and "f = π”Ÿ"
  shows "f : a' ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b'"
proof(intro is_arrI, unfold assms)
  show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡π”Ÿβ¦ˆ = π”Ÿ" "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡π”Ÿβ¦ˆ = π”Ÿ"
    by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components)

lemma (in cat_parallel) the_cat_parallel_is_arr_π”žπ”Ÿπ”€[cat_parallel_cs_intros]:
  assumes "a' = π”ž" and "b' = π”Ÿ" and "f = 𝔀"
  shows "f : a' ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b'"
proof(intro is_arrI, unfold assms(1,2))
  from assms(3) show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡f⦈ = π”ž" "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡f⦈ = π”Ÿ"
    by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components assms(3))

lemma (in cat_parallel) the_cat_parallel_is_arr_π”žπ”Ÿπ”£[cat_parallel_cs_intros]:
  assumes "a' = π”ž" and "b' = π”Ÿ" and "f = 𝔣"
  shows "f : a' ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b'"
proof(intro is_arrI, unfold assms(1,2))
  from assms(3) show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Domβ¦ˆβ¦‡f⦈ = π”ž" "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Codβ¦ˆβ¦‡f⦈ = π”Ÿ"
    by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components assms(3))

lemma (in cat_parallel) the_cat_parallel_is_arrE:
  assumes "f' : a' ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b'"
  obtains "a' = π”ž" and "b' = π”ž" and "f' = π”ž"
        | "a' = π”Ÿ" and "b' = π”Ÿ" and "f' = π”Ÿ"
        | "a' = π”ž" and "b' = π”Ÿ" and "f' = 𝔀"
        | "a' = π”ž" and "b' = π”Ÿ" and "f' = 𝔣"
proof-
  note f = is_arrD[OF assms]
  from f(1) consider (π”ž) "f' = π”ž" | (π”Ÿ) "f' = π”Ÿ" | (𝔀) "f' = 𝔀" | (𝔣) "f' = 𝔣"
    unfolding the_cat_parallel_components(2) by auto
  then show ?thesis
  proof cases
    case π”ž
    moreover from f(2)[unfolded π”ž, symmetric] have "a' = π”ž"
      by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
    moreover from f(3)[unfolded π”ž, symmetric] have "b' = π”ž"
      by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
    ultimately show ?thesis using that by auto
  next
    case π”Ÿ
    moreover from f(2)[unfolded π”Ÿ, symmetric] have "a' = π”Ÿ"
      by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
    moreover from f(3)[unfolded π”Ÿ, symmetric] have "b' = π”Ÿ"
      by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
    ultimately show ?thesis using that by auto
  next
    case 𝔀
    moreover from f(2)[symmetric] 𝔀 have "a' = π”ž"
      by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
    moreover from f(3)[symmetric] 𝔀 have "b' = π”Ÿ"
      by (cs_prems cs_simp: cat_parallel_cs_simps)
    ultimately show ?thesis using that by auto
  next
    case 𝔣
    moreover from f(2)[symmetric] 𝔣 have "a' = π”ž"
      by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
    moreover from f(3)[symmetric] 𝔣 have "b' = π”Ÿ"
      by (cs_prems cs_simp: cat_parallel_cs_simps)
    ultimately show ?thesis using that by auto
  qed
qed


subsubsection‹‹↑↑› is a categoryβ€Ί

lemma (in cat_parallel) finite_category_the_cat_parallel[cat_parallel_cs_intros]:
  "finite_category Ξ± (↑↑C π”ž π”Ÿ 𝔀 𝔣)"
proof(intro finite_categoryI'' tiny_categoryI'')
  show "vfsequence (↑↑C π”ž π”Ÿ 𝔀 𝔣)" unfolding the_cat_parallel_def by simp
  show "vcard (↑↑C π”ž π”Ÿ 𝔀 𝔣) = 6β„•"
    unfolding the_cat_parallel_def by (simp_all add: nat_omega_simps)
  show "β„›βˆ˜ (↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Dom⦈) βŠ†βˆ˜ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈" 
    by (auto simp: the_cat_parallel_components)
  show "β„›βˆ˜ (↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Cod⦈) βŠ†βˆ˜ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈" 
    by (auto simp: the_cat_parallel_components)
  show "(gf ∈∘ π’Ÿβˆ˜ (↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Comp⦈)) =
    (
      βˆƒg f b c a.
        gf = [g, f]∘ ∧
        g : b ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c ∧
        f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b
    )"
    for gf
    unfolding the_cat_parallel_Comp_vdomain
  proof
    assume prems: "gf ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
    then obtain g f where gf_def: "gf = [g, f]∘" by auto
    from prems show 
      "βˆƒg f b c a.
        gf = [g, f]∘ ∧
        g : b ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c ∧
        f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b"
      unfolding gf_def
      by (*slow*)
        (
          cases rule: cat_parallel_composableE; 
          (intro exI conjI)?; 
          cs_concl_step?;
          (simp only:)?,
          allβ€Ήintro is_arrI, unfold the_cat_parallel_components(2)β€Ί
        )
        (
          cs_concl 
            cs_simp: cat_parallel_cs_simps V_cs_simps cs_intro: V_cs_intros
        )+
  next
    assume 
      "βˆƒg f b' c' a'.
        gf = [g, f]∘ ∧
        g : b' ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c' ∧
        f : a' ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b'"
    then obtain g f b c a 
      where gf_def: "gf = [g, f]∘" 
        and g: "g : b ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c"
        and f: "f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b" 
      by clarsimp
    from g f show "gf ∈∘ cat_parallel_composable π”ž π”Ÿ 𝔀 𝔣"
      unfolding gf_def 
      by (elim the_cat_parallel_is_arrE) (auto simp: cat_parallel_cs_intros)
  qed
  show "π’Ÿβˆ˜ (↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CId⦈) = ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈"
    by (simp add: cat_parallel_cs_simps the_cat_parallel_components)
  show "g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c"
    if "g : b ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c" and "f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b" for b c g a f
    using that
    by (elim the_cat_parallel_is_arrE; simp only:)
      (
        allβ€Ή
          solvesβ€Ήsimp add: cat_parallel_ineq cat_parallel_ineq[symmetric]β€Ί |
          cs_concl cs_simp: cat_parallel_cs_simps 
        β€Ί
      )
  show 
    "h ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = 
      h ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 (g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f)"
    if "h : c ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 d" 
      and "g : b ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c" 
      and "f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b"
    for c d h b g a f
    using that 
    by (elim the_cat_parallel_is_arrE; simp only:) (*slow*)
      (
        allβ€Ή
          solvesβ€Ήsimp only: cat_parallel_ineq cat_parallel_ineq[symmetric]β€Ί |
          cs_concl 
            cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
          β€Ί
      )
  show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡a⦈ : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 a" if "a ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈" 
    for a
  proof-
    from that consider "a = π”ž" | "a = π”Ÿ"
      unfolding the_cat_parallel_components(1) by auto
    then show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡a⦈ : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 a"
      by cases
        (
          cs_concl 
            cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
        )+
  qed
  show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡b⦈ ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f = f" 
    if "f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b" for a b f
    using that
    by (elim the_cat_parallel_is_arrE)
      (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros)
  show "f ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡b⦈ = f" 
    if "f : b ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c" for b c f
    using that
    by (elim the_cat_parallel_is_arrE)
      (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros)
  show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈ ∈∘ Vset Ξ±"
    by 
      (
        cs_concl
          cs_simp: the_cat_parallel_components nat_omega_simps 
          cs_intro: V_cs_intros cat_parallel_cs_intros
      )
  show "vfinite (↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈)" "vfinite (↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈)"
    unfolding the_cat_parallel_components by auto
qed 
  (
    cs_concl 
      cs_simp: 
        nat_omega_simps cat_parallel_cs_simps the_cat_parallel_components(2) 
      cs_intro: 
        cat_cs_intros 
        cat_parallel_cs_intros 
        V_cs_intros 
        Limit_succ_in_VsetI
  )+

lemmas [cat_parallel_cs_intros] = cat_parallel.finite_category_the_cat_parallel


subsubsectionβ€ΉOpposite parallel categoryβ€Ί

lemma (in cat_parallel) op_cat_the_cat_parallel[cat_op_simps]: 
  "op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣) = ↑↑C π”Ÿ π”ž 𝔣 𝔀"
proof(rule cat_eqI)
  interpret π”Ÿπ”ž: cat_parallel Ξ± π”Ÿ π”ž 𝔣 𝔀 by (rule cat_parallel_op) 
  show π”Ÿπ”ž: "category Ξ± (↑↑C π”Ÿ π”ž 𝔣 𝔀)"
    by (cs_concl cs_intro: cat_small_cs_intros cat_parallel_cs_intros)
  show π”žπ”Ÿ: "category Ξ± (op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣))" 
    by 
      (
        cs_concl 
          cs_intro: cat_small_cs_intros cat_op_intros cat_parallel_cs_intros
      )
  interpret π”Ÿπ”ž: category Ξ± ‹↑↑C π”Ÿ π”ž 𝔣 𝔀› by (rule π”Ÿπ”ž)
  interpret π”žπ”Ÿ: category Ξ± ‹↑↑C π”ž π”Ÿ 𝔀 𝔣›
    by (cs_concl cs_intro: cat_small_cs_intros cat_parallel_cs_intros)
  show "op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣)⦇Comp⦈ = ↑↑C π”Ÿ π”ž 𝔣 𝔀⦇Comp⦈"
  proof(rule vsv_eqI)
    show "vsv (op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣)⦇Comp⦈)"
      unfolding op_cat_components by (rule fflip_vsv)
    show "vsv (↑↑C π”Ÿ π”ž 𝔣 𝔀⦇Comp⦈)"
      by (cs_concl cs_intro: cat_parallel_cs_intros)
    show [cat_op_simps]: 
      "π’Ÿβˆ˜ (op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣)⦇Comp⦈) = π’Ÿβˆ˜ (↑↑C π”Ÿ π”ž 𝔣 𝔀⦇Comp⦈)"
      by 
        (
          cs_concl 
            cs_simp: 
              cat_parallel_composable_fconverse
              op_cat_components(5) 
              vdomain_fflip 
              cat_parallel_cs_simps 
            cs_intro: cat_cs_intros
        )
    fix gf assume "gf ∈∘ π’Ÿβˆ˜ (op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣)⦇Comp⦈)"
    then have "gf ∈∘ π’Ÿβˆ˜ (↑↑C π”Ÿ π”ž 𝔣 𝔀⦇Comp⦈)" unfolding cat_op_simps by simp
    then obtain g f a b c 
      where gf_def: "gf = [g, f]∘" 
        and g: "g : b ↦↑↑C π”Ÿ π”ž 𝔣 𝔀 c"
        and f: "f : a ↦↑↑C π”Ÿ π”ž 𝔣 𝔀 b"
      by auto
    from g f show "op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣)⦇Compβ¦ˆβ¦‡gf⦈ = ↑↑C π”Ÿ π”ž 𝔣 𝔀⦇Compβ¦ˆβ¦‡gf⦈"
      unfolding gf_def
      by (elim π”Ÿπ”ž.the_cat_parallel_is_arrE)
        (
          simp add: cat_parallel_cs_intros | 
          cs_concl 
            cs_simp: cat_op_simps cat_parallel_cs_simps 
            cs_intro: cat_cs_intros cat_parallel_cs_intros
        )+
  qed
  show "op_cat (↑↑C π”ž π”Ÿ 𝔀 𝔣)⦇CId⦈ = ↑↑C π”Ÿ π”ž 𝔣 𝔀⦇CId⦈"
  proof(unfold cat_op_simps, rule vsv_eqI, unfold cat_parallel_cs_simps)  
    fix a assume "a ∈∘ set {π”ž, π”Ÿ}"
    then consider "a = π”ž" | "a = π”Ÿ" by auto
    then show "↑↑C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡a⦈ = ↑↑C π”Ÿ π”ž 𝔣 𝔀⦇CIdβ¦ˆβ¦‡a⦈"
      by cases (cs_concl cs_simp: cat_parallel_cs_simps)+
  qed auto
qed (auto simp: the_cat_parallel_components op_cat_components)

lemmas [cat_op_simps] = cat_parallel.op_cat_the_cat_parallel



subsectionβ€ΉParallel functorβ€Ί


subsubsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The concept of a parallel functor is introduced as a convenient abstraction
for the definition of the equalizers and co-equalizers (e.g., see
Chapter III-3 and Chapter III-4 in \cite{mac_lane_categories_2010}).
β€Ί


subsubsectionβ€ΉLocal assumptions for the parallel functorβ€Ί

locale cf_parallel = cat_parallel Ξ± π”ž π”Ÿ 𝔀 𝔣 + category Ξ± β„­ 
  for Ξ± π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣' β„­ :: V +
  assumes cf_parallel_𝔀'[cat_parallel_cs_intros]: "𝔀' : π”ž' ↦ℭ π”Ÿ'"
    and cf_parallel_𝔣'[cat_parallel_cs_intros]: "𝔣' : π”ž' ↦ℭ π”Ÿ'"

lemma (in cf_parallel) cf_parallel_𝔀''[cat_parallel_cs_intros]:
  assumes "a = π”ž'" and "b = π”Ÿ'"
  shows "𝔀' : a ↦ℭ b"
  unfolding assms by (rule cf_parallel_𝔀')

lemma (in cf_parallel) cf_parallel_𝔀'''[cat_parallel_cs_intros]:
  assumes "g = 𝔀'" and "b = π”Ÿ'"
  shows "g : π”ž' ↦ℭ b"
  unfolding assms by (rule cf_parallel_𝔀')

lemma (in cf_parallel) cf_parallel_𝔀''''[cat_parallel_cs_intros]:
  assumes "g = 𝔀'" and "a = π”ž'"
  shows "g : a ↦ℭ π”Ÿ'"
  unfolding assms by (rule cf_parallel_𝔀')

lemma (in cf_parallel) cf_parallel_𝔣''[cat_parallel_cs_intros]:
  assumes "a = π”ž'" and "b = π”Ÿ'"
  shows "𝔣' : a ↦ℭ b"
  unfolding assms by (rule cf_parallel_𝔣') 

lemma (in cf_parallel) cf_parallel_𝔣'''[cat_parallel_cs_intros]:
  assumes "f = 𝔣'" and "b = π”Ÿ'"
  shows "f : π”ž' ↦ℭ b"
  unfolding assms by (rule cf_parallel_𝔣')

lemma (in cf_parallel) cf_parallel_𝔣''''[cat_parallel_cs_intros]:
  assumes "f = 𝔣'" and "a = π”ž'"
  shows "f : a ↦ℭ π”Ÿ'"
  unfolding assms by (rule cf_parallel_𝔣') 


textβ€ΉRules.β€Ί

lemma (in cf_parallel) cf_parallel_axioms[cat_parallel_cs_intros]:
  assumes "Ξ±' = Ξ±" 
    and "a = π”ž" 
    and "b = π”Ÿ" 
    and "g = 𝔀" 
    and "f = 𝔣" 
    and "a' = π”ž'" 
    and "b' = π”Ÿ'" 
    and "g' = 𝔀'" 
    and "f' = 𝔣'" 
  shows "cf_parallel Ξ±' a b g f a' b' g' f' β„­"
  unfolding assms by (rule cf_parallel_axioms)

mk_ide rf cf_parallel_def[unfolded cf_parallel_axioms_def]
  |intro cf_parallelI|
  |dest cf_parallelD[dest]|
  |elim cf_parallelE[elim]|

lemmas [cat_parallel_cs_intros] = cf_parallelD(1,2)


textβ€ΉDuality.β€Ί

lemma (in cf_parallel) cf_parallel_op[cat_op_intros]: 
  "cf_parallel Ξ± π”Ÿ π”ž 𝔣 𝔀 π”Ÿ' π”ž' 𝔣' 𝔀' (op_cat β„­)"
  by (intro cf_parallelI, unfold cat_op_simps)
    (
      cs_concl cs_simp: cs_intro: 
        cat_parallel_cs_intros cat_cs_intros cat_op_intros
    )

lemmas [cat_op_intros] = cf_parallel.cf_parallel_op


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition the_cf_parallel :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V" 
  (‹↑↑→↑↑›)
  where "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣' =
    [
      (Ξ»aβˆˆβˆ˜β†‘β†‘C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈. (a = π”ž ? π”ž' : π”Ÿ')),
      (
        Ξ»fβˆˆβˆ˜β†‘β†‘C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈.
          (
           if f = π”ž β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”ž'⦈
            | f = π”Ÿ β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”Ÿ'⦈
            | f = 𝔀 β‡’ 𝔀'
            | otherwise β‡’ 𝔣'
          )
      ),
      ↑↑C π”ž π”Ÿ 𝔀 𝔣,
      β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma the_cf_parallel_components:
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMap⦈ =
      (Ξ»aβˆˆβˆ˜β†‘β†‘C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈. (a = π”ž ? π”ž' : π”Ÿ'))"
    and "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMap⦈ =
      (
        Ξ»fβˆˆβˆ˜β†‘β†‘C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈.
          (
           if f = π”ž β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”ž'⦈
            | f = π”Ÿ β‡’ ℭ⦇CIdβ¦ˆβ¦‡π”Ÿ'⦈
            | f = 𝔀 β‡’ 𝔀'
            | otherwise β‡’ 𝔣'
          )
      )"
    and [cat_parallel_cs_simps]: 
      "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇HomDom⦈ = ↑↑C π”ž π”Ÿ 𝔀 𝔣"
    and [cat_parallel_cs_simps]: 
      "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇HomCod⦈ = β„­"
  unfolding the_cf_parallel_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda the_cf_parallel_components(1)
  |vsv the_the_cf_parallel_ObjMap_vsv[cat_parallel_cs_intros]|
  |vdomain the_cf_parallel_ObjMap_vdomain[cat_parallel_cs_simps]|
  |app the_cf_parallel_ObjMap_app|

lemma (in cf_parallel) the_cf_parallel_ObjMap_app_π”ž[cat_parallel_cs_simps]:
  assumes "x = π”ž"
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMapβ¦ˆβ¦‡x⦈ = π”ž'"
  by 
    (
      cs_concl 
        cs_simp: 
          assms the_cf_parallel_ObjMap_app cat_parallel_cs_simps V_cs_simps 
        cs_intro: cat_parallel_cs_intros
    )

lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ObjMap_app_π”ž

lemma (in cf_parallel) the_cf_parallel_ObjMap_app_π”Ÿ[cat_parallel_cs_simps]:
  assumes "x = π”Ÿ"
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMapβ¦ˆβ¦‡x⦈ = π”Ÿ'"
  using cat_parallel_ineq
  by 
    (
      cs_concl 
        cs_simp: 
          assms the_cf_parallel_ObjMap_app cat_parallel_cs_simps V_cs_simps 
        cs_intro: cat_parallel_cs_intros
    )

lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ObjMap_app_π”Ÿ

lemma (in cf_parallel) the_cf_parallel_ObjMap_vrange:
  "β„›βˆ˜ (↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
  unfolding the_cf_parallel_components
proof(intro vrange_VLambda_vsubset)
  fix a assume "a ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈"
  then consider "a = π”ž" | "a = π”Ÿ" unfolding the_cat_parallel_components by auto
  then show "(a = π”ž ? π”ž' : π”Ÿ') ∈∘ ℭ⦇Obj⦈"
    by (auto intro: cat_cs_intros cat_parallel_cs_intros)
qed


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda the_cf_parallel_components(2)
  |vsv the_cf_parallel_ArrMap_vsv[cat_parallel_cs_intros]|
  |vdomain the_cf_parallel_ArrMap_vdomain[cat_parallel_cs_simps]|
  |app the_cf_parallel_ArrMap_app|

lemma (in cf_parallel) the_cf_parallel_ArrMap_app_𝔀[cat_parallel_cs_simps]:
  assumes "f = 𝔀"
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔀'"
proof-
  from assms have "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
    by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
  from this show ?thesis
    using cat_parallel_ineq
    by (elim the_cat_parallel_ArrE; simp only: assms) 
      (auto simp: the_cf_parallel_ArrMap_app)
qed

lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_𝔀

lemma (in cf_parallel) the_cf_parallel_ArrMap_app_𝔣[cat_parallel_cs_simps]:
  assumes "f = 𝔣"
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔣'"
proof-
  from assms have "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
    by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
  from this show ?thesis
    using cat_parallel_ineq
    by (elim the_cat_parallel_ArrE; simp only: assms) 
      (auto simp: the_cf_parallel_ArrMap_app)
qed

lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_𝔣

lemma (in cf_parallel) the_cf_parallel_ArrMap_app_π”ž[cat_parallel_cs_simps]:
  assumes "f = π”ž"
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”ž'⦈"
proof-
  from assms have "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
    by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
  from this show ?thesis
    using cat_parallel_ineq
    by (elim the_cat_parallel_ArrE; simp only: assms) 
      (auto simp: the_cf_parallel_ArrMap_app)
qed

lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_π”ž

lemma (in cf_parallel) the_cf_parallel_ArrMap_app_π”Ÿ[cat_parallel_cs_simps]:
  assumes "f = π”Ÿ"
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”Ÿ'⦈"
proof-
  from assms have "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
    by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
  from this show ?thesis
    using cat_parallel_ineq
    by (elim the_cat_parallel_ArrE; simp only: assms) 
      (auto simp: the_cf_parallel_ArrMap_app)
qed

lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_π”Ÿ

lemma (in cf_parallel) the_cf_parallel_ArrMap_vrange:
  "β„›βˆ˜ (↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof(intro vsv.vsv_vrange_vsubset, unfold cat_parallel_cs_simps)
  show "vsv (↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMap⦈)" 
    by (cs_intro_step cat_parallel_cs_intros)
  fix f assume "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
  then show "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈ ∈∘ ℭ⦇Arr⦈"
    by (elim the_cat_parallel_ArrE; simp only:)
      (
        cs_concl
          cs_simp: cat_parallel_cs_simps  
          cs_intro: cat_cs_intros cat_parallel_cs_intros 
      )+
qed


subsubsectionβ€ΉParallel functor is a functorβ€Ί

lemma (in cf_parallel) cf_parallel_the_cf_parallel_is_tm_functor:
  "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣' : ↑↑C π”ž π”Ÿ 𝔀 𝔣 ↦↦C.tmΞ± β„­"
proof(intro is_functor.cf_is_tm_functor_if_HomDom_finite_category is_functorI')
  show "vfsequence (↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣')" 
    unfolding the_cf_parallel_def by auto
  show "vcard (↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣') = 4β„•"
    unfolding the_cf_parallel_def by (simp add: nat_omega_simps)
  show "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈ :
    ↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ
    ↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b" for a b f
    using that
    by (cases rule: the_cat_parallel_is_arrE; simp only:)
      (
        cs_concl
          cs_simp: cat_parallel_cs_simps
          cs_intro: cat_cs_intros cat_parallel_cs_intros
      )+
  show
    "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡g ∘A↑↑C π”ž π”Ÿ 𝔀 𝔣 f⦈ =
      ↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­
      ↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈"
    if "g : b ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 c" and "f : a ↦↑↑C π”ž π”Ÿ 𝔀 𝔣 b" for b c g a f
    using that
    by (elim the_cat_parallel_is_arrE) (*very slow*)
      (
        allβ€Ήsimp only:β€Ί, 
        allβ€Ή
          solvesβ€Ήsimp add: cat_parallel_ineq cat_parallel_ineq[symmetric]β€Ί | 
          cs_concl 
            cs_simp: cat_cs_simps cat_parallel_cs_simps 
            cs_intro: cat_cs_intros cat_parallel_cs_intros
          β€Ί
      )
  show 
    "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡β†‘β†‘C π”ž π”Ÿ 𝔀 𝔣⦇CIdβ¦ˆβ¦‡c⦈⦈ =
      ℭ⦇CIdβ¦ˆβ¦‡β†‘β†‘β†’β†‘β†‘ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
    if "c ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈" for c
    using that
    by (elim the_cat_parallel_ObjE; simp only:)
      (cs_concl cs_simp: cat_parallel_cs_simps)+
qed 
  (
    cs_concl 
      cs_simp: cat_parallel_cs_simps 
      cs_intro: 
        the_cf_parallel_ObjMap_vrange 
        cat_parallel_cs_intros 
        cat_cs_intros 
        cat_small_cs_intros
  )+

lemma (in cf_parallel) cf_parallel_the_cf_parallel_is_tm_functor':
  assumes "𝔄' = ↑↑C π”ž π”Ÿ 𝔀 𝔣" and "β„­' = β„­"
  shows "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣' : 𝔄' ↦↦C.tmΞ± β„­'"
  unfolding assms by (rule cf_parallel_the_cf_parallel_is_tm_functor)

lemmas [cat_parallel_cs_intros] = 
  cf_parallel.cf_parallel_the_cf_parallel_is_tm_functor'


subsubsectionβ€ΉOpposite parallel functorβ€Ί

lemma (in cf_parallel) cf_parallel_the_cf_parallel_op[cat_op_simps]:
  "op_cf (↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣') = ↑↑→↑↑ (op_cat β„­) π”Ÿ π”ž 𝔣 𝔀 π”Ÿ' π”ž' 𝔣' 𝔀'"
proof-
  interpret ↑: is_tm_functor Ξ± ‹↑↑C π”ž π”Ÿ 𝔀 𝔣› β„­ ‹↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'β€Ί
    by (rule cf_parallel_the_cf_parallel_is_tm_functor)
  show ?thesis
  proof
    (
      rule cf_eqI[of Ξ± ‹↑↑C π”Ÿ π”ž 𝔣 𝔀› β€Ήop_cat β„­β€Ί _ ‹↑↑C π”Ÿ π”ž 𝔣 𝔀› β€Ήop_cat β„­β€Ί], 
      unfold cat_op_simps
    )
    show "op_cf (↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣') : ↑↑C π”Ÿ π”ž 𝔣 𝔀 ↦↦CΞ± op_cat β„­"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
    show "↑↑→↑↑ (op_cat β„­) π”Ÿ π”ž 𝔣 𝔀 π”Ÿ' π”ž' 𝔣' 𝔀' : ↑↑C π”Ÿ π”ž 𝔣 𝔀 ↦↦CΞ± op_cat β„­"
      by 
        (
          cs_concl 
            cs_intro: cat_op_intros cat_small_cs_intros cat_parallel_cs_intros
        )
    show  
      "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMap⦈ = 
        ↑↑→↑↑ (op_cat β„­) π”Ÿ π”ž 𝔣 𝔀 π”Ÿ' π”ž' 𝔣' 𝔀'⦇ObjMap⦈"
    proof
      (
        rule vsv_eqI;
        (intro cat_parallel_cs_intros)?; 
        unfold cat_parallel_cs_simps
      )
      fix a assume "a ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Obj⦈"
      then consider "a = π”ž" | "a = π”Ÿ" by (elim the_cat_parallel_ObjE) simp
      then show 
        "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ObjMapβ¦ˆβ¦‡a⦈ =
          ↑↑→↑↑ (op_cat β„­) π”Ÿ π”ž 𝔣 𝔀 π”Ÿ' π”ž' 𝔣' 𝔀'⦇ObjMapβ¦ˆβ¦‡a⦈"
        by cases
          (
            cs_concl 
              cs_simp: cat_parallel_cs_simps 
              cs_intro: cat_parallel_cs_intros cat_op_intros
          )
    qed (auto simp: the_cat_parallel_components)
    show 
      "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣 π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMap⦈ = 
        ↑↑→↑↑ (op_cat β„­) π”Ÿ π”ž 𝔣 𝔀 π”Ÿ' π”ž' 𝔣' 𝔀'⦇ArrMap⦈"
    proof
      (
        rule vsv_eqI; 
        (intro cat_parallel_cs_intros)?; 
        unfold cat_parallel_cs_simps
      )
      fix f assume "f ∈∘ ↑↑C π”ž π”Ÿ 𝔀 𝔣⦇Arr⦈"
      then consider "f = π”ž" | "f = π”Ÿ" | "f = 𝔀" | "f = 𝔣" 
        by (elim the_cat_parallel_ArrE) simp
      then show 
        "↑↑→↑↑ β„­ π”ž π”Ÿ 𝔀 𝔣  π”ž' π”Ÿ' 𝔀' 𝔣'⦇ArrMapβ¦ˆβ¦‡f⦈ =
          ↑↑→↑↑ (op_cat β„­) π”Ÿ π”ž 𝔣 𝔀 π”Ÿ' π”ž' 𝔣' 𝔀'⦇ArrMapβ¦ˆβ¦‡f⦈"
        by cases
          (
            cs_concl 
              cs_simp: cat_parallel_cs_simps cat_op_simps 
              cs_intro: cat_parallel_cs_intros cat_op_intros
          )+
    qed (auto simp: the_cat_parallel_components)
  qed simp_all
qed

lemmas [cat_op_simps] = cf_parallel.cf_parallel_the_cf_parallel_op

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Comma

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉComma categoriesβ€Ί
theory CZH_ECAT_Comma
  imports 
    CZH_ECAT_NTCF
    CZH_ECAT_Simple
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems cat_comma_cs_simps
named_theorems cat_comma_cs_intros



subsectionβ€ΉComma categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
See Exercise 1.3.vi in \cite{riehl_category_2016} or 
Chapter II-6 in \cite{mac_lane_categories_2010}.
β€Ί

definition cat_comma_Obj :: "V β‡’ V β‡’ V"
  where "cat_comma_Obj π”Š β„Œ ≑ set
    {
      [a, b, f]∘ | a b f.
        a ∈∘ π”Šβ¦‡HomDomβ¦ˆβ¦‡Obj⦈ ∧
        b ∈∘ β„Œβ¦‡HomDomβ¦ˆβ¦‡Obj⦈ ∧
        f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ β†¦π”Šβ¦‡HomCod⦈ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈
    }"

lemma small_cat_comma_Obj[simp]: 
  "small
    {
      [a, b, f]∘ | a b f.
        a ∈∘ 𝔄⦇Obj⦈ ∧ b ∈∘ 𝔅⦇Obj⦈ ∧ f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈
    }"
  (is β€Ήsmall ?abfsβ€Ί)
proof-
  define Q where
    "Q i = (if i = 0 then 𝔄⦇Obj⦈ else if i = 1β„• then 𝔅⦇Obj⦈ else ℭ⦇Arr⦈)" 
    for i
  have "?abfs βŠ† elts (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
    unfolding Q_def
  proof
    (
      intro subsetI, 
      unfold mem_Collect_eq, 
      elim exE conjE, 
      intro vproductI; 
      simp only:
    )
    fix a b f show "π’Ÿβˆ˜ [a, b, f]∘ = set {0, 1β„•, 2β„•}"
      by (simp add: three nat_omega_simps)
  qed (force simp: nat_omega_simps)+
  then show "small ?abfs" by (rule down)
qed

definition cat_comma_Hom :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "cat_comma_Hom π”Š β„Œ abf a'b'f' ≑ set
    {
      [abf, a'b'f', [g, h]∘]∘ | g h.
        abf ∈∘ cat_comma_Obj π”Š β„Œ ∧
        a'b'f' ∈∘ cat_comma_Obj π”Š β„Œ ∧
        g : abf⦇0⦈ β†¦π”Šβ¦‡HomDom⦈ a'b'f'⦇0⦈ ∧
        h : abf⦇1β„•β¦ˆ β†¦β„Œβ¦‡HomDom⦈ a'b'f'⦇1β„•β¦ˆ ∧
        a'b'f'⦇2β„•β¦ˆ ∘Aπ”Šβ¦‡HomCod⦈ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ =
         β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aπ”Šβ¦‡HomCod⦈ abf⦇2β„•β¦ˆ
    }"

lemma small_cat_comma_Hom[simp]: "small
  {
    [abf, a'b'f', [g, h]∘]∘ | g h.
      abf ∈∘ cat_comma_Obj π”Š β„Œ ∧
      a'b'f' ∈∘ cat_comma_Obj π”Š β„Œ ∧
      g : abf⦇0⦈ ↦𝔄 a'b'f'⦇0⦈ ∧
      h : abf⦇1β„•β¦ˆ ↦𝔅 a'b'f'⦇1β„•β¦ˆ ∧
      a'b'f'⦇2β„•β¦ˆ ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ abf⦇2β„•β¦ˆ
  }"
  (is β€Ήsmall ?abf_a'b'f'_ghβ€Ί)
proof-
  define Q where
    "Q i =
      (
        if i = 0
        then cat_comma_Obj π”Š β„Œ 
        else if i = 1β„• then cat_comma_Obj π”Š β„Œ else 𝔄⦇Arr⦈ Γ—βˆ™ 𝔅⦇Arr⦈
      )"
    for i
  have "?abf_a'b'f'_gh βŠ† elts (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
    unfolding Q_def
  proof
    (
      intro subsetI, 
      unfold mem_Collect_eq, 
      elim exE conjE,
      intro vproductI; 
      simp only:
    )
    fix a b f show "π’Ÿβˆ˜ [a, b, f]∘ = ZFC_in_HOL.set {0, 1β„•, 2β„•}"
      by (simp add: three nat_omega_simps)
  qed (force simp : nat_omega_simps)+
  then show "small ?abf_a'b'f'_gh" by (rule down)
qed

definition cat_comma_Arr :: "V β‡’ V β‡’ V"
  where "cat_comma_Arr π”Š β„Œ ≑
    (
      β‹ƒβˆ˜abf∈∘cat_comma_Obj π”Š β„Œ. β‹ƒβˆ˜a'b'f'∈∘cat_comma_Obj π”Š β„Œ.
        cat_comma_Hom π”Š β„Œ abf a'b'f'
    )"

definition cat_comma_composable :: "V β‡’ V β‡’ V"
  where "cat_comma_composable π”Š β„Œ ≑ set
    {
      [[a'b'f', a''b''f'', g'h']∘, [abf, a'b'f', gh]∘]∘ |
        abf a'b'f' a''b''f'' g'h' gh.
          [a'b'f', a''b''f'', g'h']∘ ∈∘ cat_comma_Arr π”Š β„Œ ∧
          [abf, a'b'f', gh]∘ ∈∘ cat_comma_Arr π”Š β„Œ
    }"

lemma small_cat_comma_composable[simp]:
  shows "small
    {
      [[a'b'f', a''b''f'', g'h']∘, [abf, a'b'f', gh]∘]∘ |
        abf a'b'f' a''b''f'' g'h' gh.
          [a'b'f', a''b''f'', g'h']∘ ∈∘ cat_comma_Arr π”Š β„Œ ∧
          [abf, a'b'f', gh]∘ ∈∘ cat_comma_Arr π”Š β„Œ
    }"
  (is β€Ήsmall ?Sβ€Ί)
proof(rule down)
  show "?S βŠ† elts (cat_comma_Arr π”Š β„Œ Γ—βˆ™ cat_comma_Arr π”Š β„Œ)" by auto
qed

definition cat_comma :: "V β‡’ V β‡’ V" (β€Ή(_ CF↓CF _)β€Ί [1000, 1000] 999)
  where "π”Š CF↓CF β„Œ =
    [
      cat_comma_Obj π”Š β„Œ,
      cat_comma_Arr π”Š β„Œ,
      (Ξ»F∈∘cat_comma_Arr π”Š β„Œ. F⦇0⦈),
      (Ξ»F∈∘cat_comma_Arr π”Š β„Œ. F⦇1β„•β¦ˆ),
      (
        Ξ»GF∈∘cat_comma_composable π”Š β„Œ.
          [
            GF⦇1β„•β¦ˆβ¦‡0⦈,
            GF⦇0β¦ˆβ¦‡1β„•β¦ˆ,
            [
              GF⦇0β¦ˆβ¦‡2β„•β¦ˆβ¦‡0⦈ ∘Aπ”Šβ¦‡HomDom⦈ GF⦇1β„•β¦ˆβ¦‡2β„•β¦ˆβ¦‡0⦈,
              GF⦇0β¦ˆβ¦‡2β„•β¦ˆβ¦‡1β„•β¦ˆ ∘Aβ„Œβ¦‡HomDom⦈ GF⦇1β„•β¦ˆβ¦‡2β„•β¦ˆβ¦‡1β„•β¦ˆ
            ]∘
          ]∘
      ),
      (
        Ξ»abf∈∘cat_comma_Obj π”Š β„Œ.
          [abf, abf, [π”Šβ¦‡HomDomβ¦ˆβ¦‡CIdβ¦ˆβ¦‡abf⦇0⦈⦈, β„Œβ¦‡HomDomβ¦ˆβ¦‡CIdβ¦ˆβ¦‡abf⦇1β„•β¦ˆβ¦ˆ]∘]∘
      )
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_comma_components:
  shows "π”Š CF↓CF β„Œβ¦‡Obj⦈ = cat_comma_Obj π”Š β„Œ"
    and "π”Š CF↓CF β„Œβ¦‡Arr⦈ = cat_comma_Arr π”Š β„Œ"
    and "π”Š CF↓CF β„Œβ¦‡Dom⦈ = (Ξ»F∈∘cat_comma_Arr π”Š β„Œ. F⦇0⦈)"
    and "π”Š CF↓CF β„Œβ¦‡Cod⦈ = (Ξ»F∈∘cat_comma_Arr π”Š β„Œ. F⦇1β„•β¦ˆ)"
    and "π”Š CF↓CF β„Œβ¦‡Comp⦈ =
      (
        Ξ»GF∈∘cat_comma_composable π”Š β„Œ.
          [
            GF⦇1β„•β¦ˆβ¦‡0⦈,
            GF⦇0β¦ˆβ¦‡1β„•β¦ˆ,
            [
              GF⦇0β¦ˆβ¦‡2β„•β¦ˆβ¦‡0⦈ ∘Aπ”Šβ¦‡HomDom⦈ GF⦇1β„•β¦ˆβ¦‡2β„•β¦ˆβ¦‡0⦈,
              GF⦇0β¦ˆβ¦‡2β„•β¦ˆβ¦‡1β„•β¦ˆ ∘Aβ„Œβ¦‡HomDom⦈ GF⦇1β„•β¦ˆβ¦‡2β„•β¦ˆβ¦‡1β„•β¦ˆ
            ]∘
          ]∘
      )"
    and "π”Š CF↓CF β„Œβ¦‡CId⦈ =
      (
        Ξ»abf∈∘cat_comma_Obj π”Š β„Œ.
          [abf, abf, [π”Šβ¦‡HomDomβ¦ˆβ¦‡CIdβ¦ˆβ¦‡abf⦇0⦈⦈, β„Œβ¦‡HomDomβ¦ˆβ¦‡CIdβ¦ˆβ¦‡abf⦇1β„•β¦ˆβ¦ˆ]∘]∘
      )"
  unfolding cat_comma_def dg_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔄 𝔅 β„­ π”Š β„Œ
  assumes π”Š: "π”Š : 𝔄 ↦↦CΞ± β„­"
    and β„Œ: "β„Œ : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Š: is_functor Ξ± 𝔄 β„­ π”Š by (rule π”Š)
interpretation β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule β„Œ)

lemma cat_comma_Obj_def':
  "cat_comma_Obj π”Š β„Œ ≑ set
    {
      [a, b, f]∘ | a b f.
        a ∈∘ 𝔄⦇Obj⦈ ∧ b ∈∘ 𝔅⦇Obj⦈ ∧ f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈
    }"
  unfolding cat_comma_Obj_def cat_cs_simps by simp

lemma cat_comma_Hom_def':
  "cat_comma_Hom π”Š β„Œ abf a'b'f' ≑ set
    {
      [abf, a'b'f', [g, h]∘]∘ | g h.
        abf ∈∘ cat_comma_Obj π”Š β„Œ ∧
        a'b'f' ∈∘ cat_comma_Obj π”Š β„Œ ∧
        g : abf⦇0⦈ ↦𝔄 a'b'f'⦇0⦈ ∧
        h : abf⦇1β„•β¦ˆ ↦𝔅 a'b'f'⦇1β„•β¦ˆ ∧
        a'b'f'⦇2β„•β¦ˆ ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ abf⦇2β„•β¦ˆ
    }"
  unfolding cat_comma_Hom_def cat_cs_simps by simp

lemma cat_comma_components':
  shows "π”Š CF↓CF β„Œβ¦‡Obj⦈ = cat_comma_Obj π”Š β„Œ"
    and "π”Š CF↓CF β„Œβ¦‡Arr⦈ = cat_comma_Arr π”Š β„Œ"
    and "π”Š CF↓CF β„Œβ¦‡Dom⦈ = (Ξ»F∈∘cat_comma_Arr π”Š β„Œ. F⦇0⦈)"
    and "π”Š CF↓CF β„Œβ¦‡Cod⦈ = (Ξ»F∈∘cat_comma_Arr π”Š β„Œ. F⦇1β„•β¦ˆ)"
    and "π”Š CF↓CF β„Œβ¦‡Comp⦈ =
      (
        Ξ»GF∈∘cat_comma_composable π”Š β„Œ.
          [
            GF⦇1β„•β¦ˆβ¦‡0⦈,
            GF⦇0β¦ˆβ¦‡1β„•β¦ˆ,
            [
              GF⦇0β¦ˆβ¦‡2β„•β¦ˆβ¦‡0⦈ ∘A𝔄 GF⦇1β„•β¦ˆβ¦‡2β„•β¦ˆβ¦‡0⦈,
              GF⦇0β¦ˆβ¦‡2β„•β¦ˆβ¦‡1β„•β¦ˆ ∘A𝔅 GF⦇1β„•β¦ˆβ¦‡2β„•β¦ˆβ¦‡1β„•β¦ˆ
            ]∘
          ]∘
      )"
    and "π”Š CF↓CF β„Œβ¦‡CId⦈ =
      (Ξ»abf∈∘cat_comma_Obj π”Š β„Œ. [abf, abf, [𝔄⦇CIdβ¦ˆβ¦‡abf⦇0⦈⦈, 𝔅⦇CIdβ¦ˆβ¦‡abf⦇1β„•β¦ˆβ¦ˆ]∘]∘)"
  unfolding cat_comma_components cat_cs_simps by simp_all

end


subsubsectionβ€ΉObjectsβ€Ί

lemma cat_comma_ObjI[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "A = [a, b, f]∘"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈" 
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
  shows "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  using assms(4-6) 
  unfolding cat_comma_Obj_def'[OF assms(1,2)] assms(3) cat_comma_components 
  by simp

lemma cat_comma_ObjD[dest]:
  assumes "[a, b, f]∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "a ∈∘ 𝔄⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈" 
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
  using assms
  unfolding 
    cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)] 
  by auto

lemma cat_comma_ObjE[elim]:
  assumes "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  obtains a b f where "A = [a, b, f]∘"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈" 
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
  using assms
  unfolding 
    cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)] 
  by auto


subsubsectionβ€ΉArrowsβ€Ί

lemma cat_comma_HomI[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "F = [abf, a'b'f', [g, h]∘]∘"
    and "abf = [a, b, f]∘"
    and "a'b'f' = [a', b', f']∘"
    and "g : a ↦𝔄 a'"
    and "h : b ↦𝔅 b'"
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
    and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
  shows "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
  using assms(1,2,6-10)
  unfolding cat_comma_Hom_def'[OF assms(1,2)] assms(3-5)
  by 
    (
      intro in_set_CollectI exI conjI small_cat_comma_Hom, 
      unfold cat_comma_components'(1,2)[OF assms(1,2), symmetric],
      (
        cs_concl 
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )+
    )
    (clarsimp simp: nat_omega_simps)+

lemma cat_comma_HomE[elim]:
  assumes "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  obtains a b f a' b' f' g h
    where "F = [abf, a'b'f', [g, h]∘]∘"
      and "abf = [a, b, f]∘"
      and "a'b'f' = [a', b', f']∘"
      and "g : a ↦𝔄 a'"
      and "h : b ↦𝔅 b'"
      and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
  using assms(1) 
  by 
    (
      unfold
        cat_comma_components'[OF assms(2,3)] cat_comma_Hom_def'[OF assms(2,3)],
      elim in_small_setE; 
      (unfold mem_Collect_eq, elim exE conjE cat_comma_ObjE[OF _ assms(2,3)])?,
      insert that,
      allβ€Ή
        (unfold cat_comma_components'(1,2)[OF assms(2,3), symmetric],
        elim cat_comma_ObjE[OF _ assms(2,3)]) | -
        β€Ί
    )
    (auto simp: nat_omega_simps)

lemma cat_comma_HomD[dest]:
  assumes "[[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘ ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "g : a ↦𝔄 a'"
    and "h : b ↦𝔅 b'"
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
    and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
  using assms(1) by (force elim!: cat_comma_HomE[OF _ assms(2,3)])+

lemma cat_comma_ArrI[cat_comma_cs_intros]: 
  assumes "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
    and "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    and "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  shows "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  using assms 
  unfolding cat_comma_components cat_comma_Arr_def 
  by (intro vifunionI)

lemma cat_comma_ArrE[elim]:
  assumes "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  obtains abf a'b'f' 
    where "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
      and "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
      and "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  using assms unfolding cat_comma_components cat_comma_Arr_def by auto

lemma cat_comma_ArrD[dest]: 
  assumes "[abf, a'b'f', gh]∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "[abf, a'b'f', gh]∘ ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
    and "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    and "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
proof-
  from assms obtain abf' a'b'f'' 
    where "[abf, a'b'f', gh]∘ ∈∘ cat_comma_Hom π”Š β„Œ abf' a'b'f''"
      and "abf' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
      and "a'b'f'' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    by (elim cat_comma_ArrE)
  moreover from cat_comma_HomE[OF this(1) assms(2,3)] have 
    "abf = abf'" and "a'b'f' = a'b'f''"
    by auto
  ultimately show "[abf, a'b'f', gh]∘ ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
    and "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    and "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    by auto
qed


subsubsectionβ€ΉDomainβ€Ί

lemma cat_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (π”Š CF↓CF β„Œβ¦‡Dom⦈)"
  unfolding cat_comma_components by simp

lemma cat_comma_Dom_vdomain[cat_comma_cs_simps]:
  "π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡Dom⦈) = π”Š CF↓CF β„Œβ¦‡Arr⦈"
  unfolding cat_comma_components by simp

lemma cat_comma_Dom_app[cat_comma_cs_simps]:
  assumes "F = [abf, a'b'f', gh]∘" and "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  shows "π”Š CF↓CF β„Œβ¦‡Domβ¦ˆβ¦‡F⦈ = abf"
  using assms(2) unfolding assms(1) cat_comma_components by simp

lemma cat_comma_Dom_vrange:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (π”Š CF↓CF β„Œβ¦‡Dom⦈) βŠ†βˆ˜ π”Š CF↓CF β„Œβ¦‡Obj⦈"
proof(rule vsv.vsv_vrange_vsubset)
  fix F assume "F ∈∘ π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡Dom⦈)"
  then have "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈" by (cs_prems cs_simp: cat_comma_cs_simps)
  then obtain abf a'b'f' 
    where F: "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
      and abf: "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
      and a'b'f': "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    by auto
  from this(1) obtain a b f a' b' f' g h
    where "F = [abf, a'b'f', [g, h]∘]∘"
      and "abf = [a, b, f]∘"
      and "a'b'f' = [a', b', f']∘"
      and "g : a ↦𝔄 a'"
      and "h : b ↦𝔅 b'"
      and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
    by (elim cat_comma_HomE[OF _ assms(1,2)])
  from F this abf a'b'f' show "π”Š CF↓CF β„Œβ¦‡Domβ¦ˆβ¦‡F⦈ ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
qed (auto intro: cat_comma_cs_intros)


subsubsectionβ€ΉCodomainβ€Ί

lemma cat_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (π”Š CF↓CF β„Œβ¦‡Cod⦈)"
  unfolding cat_comma_components by simp

lemma cat_comma_Cod_vdomain[cat_comma_cs_simps]:
  "π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡Cod⦈) = π”Š CF↓CF β„Œβ¦‡Arr⦈"
  unfolding cat_comma_components by simp

lemma cat_comma_Cod_app[cat_comma_cs_simps]:
  assumes "F = [abf, a'b'f', gh]∘" and "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  shows "π”Š CF↓CF β„Œβ¦‡Codβ¦ˆβ¦‡F⦈ = a'b'f'"
  using assms(2)
  unfolding assms(1) cat_comma_components
  by (simp add: nat_omega_simps)

lemma cat_comma_Cod_vrange:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (π”Š CF↓CF β„Œβ¦‡Cod⦈) βŠ†βˆ˜ π”Š CF↓CF β„Œβ¦‡Obj⦈"
proof(rule vsv.vsv_vrange_vsubset)
  fix F assume "F ∈∘ π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡Cod⦈)"
  then have "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈" by (cs_prems cs_simp: cat_comma_cs_simps)
  then obtain abf a'b'f' 
    where F: "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
      and abf: "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
      and a'b'f': "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    by auto
  from this(1) obtain a b f a' b' f' g h
    where "F = [abf, a'b'f', [g, h]∘]∘"
      and "abf = [a, b, f]∘"
      and "a'b'f' = [a', b', f']∘"
      and "g : a ↦𝔄 a'"
      and "h : b ↦𝔅 b'"
      and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
    by (elim cat_comma_HomE[OF _ assms(1,2)])
  from F this abf a'b'f' show "π”Š CF↓CF β„Œβ¦‡Codβ¦ˆβ¦‡F⦈ ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
qed (auto intro: cat_comma_cs_intros)


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma cat_comma_is_arrI[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "F = [abf, a'b'f', gh]∘"
    and "abf = [a, b, f]∘"
    and "a'b'f' = [a', b', f']∘"
    and "gh = [g, h]∘"
    and "g : a ↦𝔄 a'"
    and "h : b ↦𝔅 b'"
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
    and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
  shows "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
proof(intro is_arrI)
  interpret π”Š: is_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))
  from assms(7-11) show "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
    unfolding assms(3-6)
    by 
      (
        cs_concl 
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  with assms(7-11) show 
    "π”Š CF↓CF β„Œβ¦‡Domβ¦ˆβ¦‡F⦈ = abf" "π”Š CF↓CF β„Œβ¦‡Codβ¦ˆβ¦‡F⦈ = a'b'f'"
    unfolding assms(3-6) by (cs_concl cs_simp: cat_comma_cs_simps)+
qed

lemma cat_comma_is_arrD[dest]:
  assumes "[[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘ :
    [a, b, f]∘ β†¦π”Š CF↓CF β„Œ [a', b', f']∘"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "g : a ↦𝔄 a'"
    and "h : b ↦𝔅 b'"
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
    and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
proof-
  note F_is_arrD = is_arrD[OF assms(1)]
  note F_cat_comma_ArrD = cat_comma_ArrD[OF F_is_arrD(1) assms(2,3)]
  show "g : a ↦𝔄 a'"
    and "h : b ↦𝔅 b'"
    and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
    and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
    by (intro cat_comma_HomD[OF F_cat_comma_ArrD(1) assms(2,3)])+    
qed

lemma cat_comma_is_arrE[elim]:
  assumes "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  obtains a b f a' b' f' g h
    where "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
      and "abf = [a, b, f]∘"
      and "a'b'f' = [a', b', f']∘"
      and "g : a ↦𝔄 a'"
      and "h : b ↦𝔅 b'"
      and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
proof-
  note F_is_arrD = is_arrD[OF assms(1)]
  from F_is_arrD(1) obtain abf a'b'f' 
    where "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
      and "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" 
      and "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    by auto
  from this(1) obtain a b f a' b' f' g h
    where F_def: "F = [abf, a'b'f', [g, h]∘]∘"
      and "abf = [a, b, f]∘"
      and "a'b'f' = [a', b', f']∘"
      and "g : a ↦𝔄 a'"
      and "h : b ↦𝔅 b'"
      and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
     by (elim cat_comma_HomE[OF _ assms(2,3)])
  with that show ?thesis 
    by (metis F_is_arrD(1,2,3) cat_comma_Cod_app cat_comma_Dom_app)
qed


subsubsectionβ€ΉCompositionβ€Ί

lemma cat_comma_composableI:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "GF = [G, F]∘"
    and "G : a'b'f' β†¦π”Š CF↓CF β„Œ a''b''f''"
    and "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
  shows "GF ∈∘ cat_comma_composable π”Š β„Œ"
proof-
  from assms(1,2,5) obtain a b f a' b' f' gh 
    where F_def: "F = [[a, b, f]∘, [a', b', f']∘, gh]∘"
      and "abf = [a, b, f]∘"
      and  "a'b'f' = [a', b', f']∘"
    by auto
  with assms(1,2,4) obtain a'' b'' f'' g'h' 
    where G_def: "G = [[a', b', f']∘, [a'', b'', f'']∘, g'h']∘"
      and "a'b'f' = [a', b', f']∘"
      and "a''b''f'' = [a'', b'', f'']∘"
    by auto
  from is_arrD(1)[OF assms(4)] have "G ∈∘ cat_comma_Arr π”Š β„Œ"
    unfolding cat_comma_components'(2)[OF assms(1,2)].
  moreover from is_arrD(1)[OF assms(5)] have "F ∈∘ cat_comma_Arr π”Š β„Œ"
    unfolding cat_comma_components'(2)[OF assms(1,2)].
  ultimately show ?thesis 
    unfolding assms(3) F_def G_def cat_comma_composable_def 
    by simp
qed

lemma cat_comma_composableE[elim]:
  assumes "GF ∈∘ cat_comma_composable π”Š β„Œ"
    and "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  obtains G F abf a'b'f' a''b''f'' 
    where "GF = [G, F]∘"
      and "G : a'b'f' β†¦π”Š CF↓CF β„Œ a''b''f''"
      and "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
proof-
  from assms(1) obtain abf a'b'f' a''b''f'' g'h' gh 
    where GF_def: "GF = [[a'b'f', a''b''f'', g'h']∘, [abf, a'b'f', gh]∘]∘"
      and g'h': "[a'b'f', a''b''f'', g'h']∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
      and gh: "[abf, a'b'f', gh]∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
    unfolding cat_comma_composable_def
    by (auto simp: cat_comma_components'[OF assms(2,3)])  
  note g'h' = cat_comma_ArrD[OF g'h' assms(2,3)]
    and gh = cat_comma_ArrD[OF gh assms(2,3)]
  from gh(1) assms(2,3) obtain a b f a' b' f' g h
    where "[abf, a'b'f', gh]∘ = [abf, a'b'f', [g, h]∘]∘"
      and abf_def: "abf = [a, b, f]∘"
      and a'b'f'_def: "a'b'f' = [a', b', f']∘"
      and gh_def: "gh = [g, h]∘"
      and g: "g : a ↦𝔄 a'"
      and h: "h : b ↦𝔅 b'"
      and f: "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      and f': "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and [cat_comma_cs_simps]: 
        "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
    by auto
  with g'h'(1) assms(2,3) obtain a'' b'' f'' g' h'
    where g'h'_def: "[a'b'f', a''b''f'', g'h']∘ = [a'b'f', a''b''f'', [g', h']∘]∘"
      and a''b''f''_def: "a''b''f'' = [a'', b'', f'']∘"
      and g'h'_def: "g'h' = [g', h']∘"
      and g': "g' : a' ↦𝔄 a''"
      and h': "h' : b' ↦𝔅 b''"
      and f'': "f'' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a''⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
      and [cat_comma_cs_simps]: 
        "f'' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'"
    by auto  
  from gh_def have "gh = [g, h]∘" by simp
  from assms(2,3) GF_def g h f f' g' h' f'' have 
    "[a'b'f', a''b''f'', g'h']∘ : a'b'f' β†¦π”Š CF↓CF β„Œ a''b''f''"
    unfolding GF_def gh_def g'h'_def abf_def a'b'f'_def a''b''f''_def
    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI)+
  moreover from assms(2,3) GF_def g h f f' g' h' f'' have 
    "[abf, a'b'f', gh]∘ : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
    unfolding GF_def gh_def g'h'_def abf_def a'b'f'_def a''b''f''_def
    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI)+
  ultimately show ?thesis using that GF_def by auto
qed

lemma cat_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (π”Š CF↓CF β„Œβ¦‡Comp⦈)"
  unfolding cat_comma_components by auto

lemma cat_comma_Comp_vdomain[cat_comma_cs_simps]: 
  "π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡Comp⦈) = cat_comma_composable π”Š β„Œ"
  unfolding cat_comma_components by auto

lemma cat_comma_Comp_app[cat_comma_cs_simps]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "G = [a'b'f', a''b''f'', [g', h']∘]∘"
    and "F = [abf, a'b'f', [g, h]∘]∘"
    and "G : a'b'f' β†¦π”Š CF↓CF β„Œ a''b''f''" 
    and "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
  shows "G ∘Aπ”Š CF↓CF β„Œ F = [abf, a''b''f'', [g' ∘A𝔄 g, h' ∘A𝔅 h]∘]∘"
  using assms(1,2,5,6)
  unfolding cat_comma_components'[OF assms(1,2)] assms(3,4)
  by (*slow*)
    (
      cs_concl
        cs_simp: omega_of_set V_cs_simps vfsequence_simps
        cs_intro: nat_omega_intros V_cs_intros cat_comma_composableI TrueI
    )

lemma cat_comma_Comp_is_arr[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "G : a'b'f' β†¦π”Š CF↓CF β„Œ a''b''f''" 
    and "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
  shows "G ∘Aπ”Š CF↓CF β„Œ F : abf β†¦π”Š CF↓CF β„Œ a''b''f''"
proof-
  interpret π”Š: is_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))
  from assms(1,2,4) obtain a b f a' b' f' g h
    where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
      and abf_def: "abf = [a, b, f]∘"
      and a'b'f'_def: "a'b'f' = [a', b', f']∘"
      and g: "g : a ↦𝔄 a'"
      and h: "h : b ↦𝔅 b'"
      and f: "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      and f': "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and [symmetric, cat_cs_simps]: 
        "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
    by auto
  with assms(1,2,3) obtain a'' b'' f'' g' h'
    where G_def: "G = [[a', b', f']∘, [a'', b'', f'']∘, [g', h']∘]∘"
      and a''b''f''_def: "a''b''f'' = [a'', b'', f'']∘"
      and g': "g' : a' ↦𝔄 a''"
      and h': "h' : b' ↦𝔅 b''"
      and f': "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and f'': "f'' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a''⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
      and [cat_cs_simps]: "f'' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'"
    by auto (*slow*)
  from g' have π”Šg': "π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡a''⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  note [cat_cs_simps] = 
    category.cat_assoc_helper[
      where β„­=β„­ and h=f'' and g=β€Ήπ”Šβ¦‡ArrMapβ¦ˆβ¦‡g'β¦ˆβ€Ί and q=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β€Ί
      ]
    category.cat_assoc_helper[
      where β„­=β„­ and h=f and g=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡hβ¦ˆβ€Ί and q=β€Ήf' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡gβ¦ˆβ€Ί
      ]
  from assms(1,2,3,4) g h f f' g' h' f'' show ?thesis
    unfolding F_def G_def abf_def a'b'f'_def a''b''f''_def
    by (intro cat_comma_is_arrI[OF assms(1,2)])
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
      )+
qed


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_comma_CId_vsv[cat_comma_cs_intros]: "vsv (π”Š CF↓CF β„Œβ¦‡CId⦈)"
  unfolding cat_comma_components by simp

lemma cat_comma_CId_vdomain[cat_comma_cs_simps]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡CId⦈) = π”Š CF↓CF β„Œβ¦‡Obj⦈"
  unfolding cat_comma_components'[OF assms(1,2)] by simp

lemma cat_comma_CId_app[cat_comma_cs_simps]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "A = [a, b ,f]∘"
    and "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  shows "π”Š CF↓CF β„Œβ¦‡CIdβ¦ˆβ¦‡A⦈ = [A, A, [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡b⦈]∘]∘"
proof-
  from assms(4)[unfolded assms(3), unfolded cat_comma_components'[OF assms(1,2)]]
  have "[a, b, f]∘ ∈∘ cat_comma_Obj π”Š β„Œ".
  then show ?thesis
    unfolding cat_comma_components'(6)[OF assms(1,2)] assms(3)
    by (simp add: nat_omega_simps)
qed


subsubsectionβ€Ήβ€ΉHomβ€Ί-setβ€Ί

lemma cat_comma_Hom:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "abf ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
    and "a'b'f' ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  shows "Hom (π”Š CF↓CF β„Œ) abf a'b'f' = cat_comma_Hom π”Š β„Œ abf a'b'f'"
proof(intro vsubset_antisym vsubsetI, unfold in_Hom_iff)
  fix F assume "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
  with assms(1,2) show "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
    by (elim cat_comma_is_arrE[OF _ assms(1,2)], intro cat_comma_HomI) force+
next
  fix F assume "F ∈∘ cat_comma_Hom π”Š β„Œ abf a'b'f'"
  with assms(1,2) show "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
    by (elim cat_comma_HomE[OF _ assms(1,2)], intro cat_comma_is_arrI) force+
qed


subsubsectionβ€ΉComma category is a categoryβ€Ί

lemma category_cat_comma[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "category Ξ± (π”Š CF↓CF β„Œ)"
proof-

  interpret π”Š: is_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))

  show ?thesis
  proof(rule categoryI')

    show "vfsequence (π”Š CF↓CF β„Œ)" unfolding cat_comma_def by auto
    show "vcard (π”Š CF↓CF β„Œ) = 6β„•"
      unfolding cat_comma_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (π”Š CF↓CF β„Œβ¦‡Dom⦈) βŠ†βˆ˜ π”Š CF↓CF β„Œβ¦‡Obj⦈"
      by (rule cat_comma_Dom_vrange[OF assms])
    show "β„›βˆ˜ (π”Š CF↓CF β„Œβ¦‡Cod⦈) βŠ†βˆ˜ π”Š CF↓CF β„Œβ¦‡Obj⦈"
      by (rule cat_comma_Cod_vrange[OF assms])
    show "(GF ∈∘ π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡Comp⦈)) ⟷
      (βˆƒg f b c a. GF = [g, f]∘ ∧ g : b β†¦π”Š CF↓CF β„Œ c ∧ f : a β†¦π”Š CF↓CF β„Œ b)"
      for GF
    proof(intro iffI; (elim exE conjE)?; (simp only: cat_comma_Comp_vdomain)?)
      assume prems: "GF ∈∘ cat_comma_composable π”Š β„Œ"
      with assms obtain G F abf a'b'f' a''b''f'' 
        where "GF = [G, F]∘"
          and "G : a'b'f' β†¦π”Š CF↓CF β„Œ a''b''f''"
          and "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
        by auto
      with assms show "βˆƒg f b c a.
        GF = [g, f]∘ ∧ g : b β†¦π”Š CF↓CF β„Œ c ∧ f : a β†¦π”Š CF↓CF β„Œ b"
        by auto
    qed (use assms in β€Ήcs_concl cs_intro: cat_comma_composableIβ€Ί)
    from assms show "π’Ÿβˆ˜ (π”Š CF↓CF β„Œβ¦‡CId⦈) = π”Š CF↓CF β„Œβ¦‡Obj⦈"
      by (cs_concl cs_simp: cat_comma_cs_simps)
    from assms show "g ∘Aπ”Š CF↓CF β„Œ f : a β†¦π”Š CF↓CF β„Œ c"
      if "g : b β†¦π”Š CF↓CF β„Œ c" and "f : a β†¦π”Š CF↓CF β„Œ b"
      for b c g a f
      using that by (cs_concl cs_intro: cat_comma_cs_intros)
    from assms show 
      "H ∘Aπ”Š CF↓CF β„Œ G ∘Aπ”Š CF↓CF β„Œ F =
        H ∘Aπ”Š CF↓CF β„Œ (G ∘Aπ”Š CF↓CF β„Œ F)"
      if "H : C β†¦π”Š CF↓CF β„Œ D"
        and "G : B β†¦π”Š CF↓CF β„Œ C"
        and "F : A β†¦π”Š CF↓CF β„Œ B"
      for C D H B G A F
      using assms that
    proof-
      from that(3) assms obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
          and A_def: "A = [a, b, f]∘"
          and B_def: "B = [a', b', f']∘"
          and g: "g : a ↦𝔄 a'"
          and h: "h : b ↦𝔅 b'"
          and f: "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
          and f': "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
          and [cat_cs_simps]: "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
        by auto
      with that(2) assms obtain a'' b'' f'' g' h'
        where G_def: "G = [[a', b', f']∘, [a'', b'', f'']∘, [g', h']∘]∘"
          and C_def: "C = [a'', b'', f'']∘"
          and g': "g' : a' ↦𝔄 a''"
          and h': "h' : b' ↦𝔅 b''"
          and f'': "f'' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a''⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
          and [cat_cs_simps]: 
            "f'' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'"
        by auto (*slow*)
      with that(1) assms obtain a''' b''' f''' g'' h''
        where H_def: "H = [[a'', b'', f'']∘, [a''', b''', f''']∘, [g'', h'']∘]∘"
          and D_def: "D = [a''', b''', f''']∘"
          and g'': "g'' : a'' ↦𝔄 a'''"
          and h'': "h'' : b'' ↦𝔅 b'''"
          and f''': "f''' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'''⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'''⦈"
          and [cat_cs_simps]: 
            "f''' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g''⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h''⦈ ∘Aβ„­ f''"
        by auto (*slow*)      
      note [cat_cs_simps] = 
        category.cat_assoc_helper[
          where β„­=β„­ 
            and h=f'' 
            and g=β€Ήπ”Šβ¦‡ArrMapβ¦ˆβ¦‡g'β¦ˆβ€Ί 
            and q=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β€Ί
          ]
        category.cat_assoc_helper[
          where β„­=β„­ 
            and h=f'' 
            and g=β€Ήπ”Šβ¦‡ArrMapβ¦ˆβ¦‡g'β¦ˆβ€Ί 
            and q=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β€Ί
          ]
        category.cat_assoc_helper[
          where β„­=β„­ 
            and h=f''' 
            and g=β€Ήπ”Šβ¦‡ArrMapβ¦ˆβ¦‡g''β¦ˆβ€Ί 
            and q=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡h''⦈ ∘Aβ„­ f''β€Ί
          ]
      from assms that g h f f' g' h' f'' g'' h''  f''' show ?thesis
        unfolding F_def G_def H_def A_def B_def C_def D_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed

    show "π”Š CF↓CF β„Œβ¦‡CIdβ¦ˆβ¦‡a⦈ : a β†¦π”Š CF↓CF β„Œ a"
      if "a ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" for a
      using that
      by (elim cat_comma_ObjE[OF _ assms(1)]; (simp only:)?) 
        (
          cs_concl
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+

    show "π”Š CF↓CF β„Œβ¦‡CIdβ¦ˆβ¦‡b⦈ ∘Aπ”Š CF↓CF β„Œ f = f"
      if "f : a β†¦π”Š CF↓CF β„Œ b" for a b f
      using that 
      by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+

    show "f ∘Aπ”Š CF↓CF β„Œ π”Š CF↓CF β„Œβ¦‡CIdβ¦ˆβ¦‡b⦈ = f"
      if "f : b β†¦π”Š CF↓CF β„Œ c" for b c f
      using that 
      by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
        (
          cs_concl
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+

    show "π”Š CF↓CF β„Œβ¦‡Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    proof(intro vsubsetI, elim cat_comma_ObjE[OF _ assms])
      fix F a b f assume prems: 
        "F = [a, b, f]∘" 
        "a ∈∘ 𝔄⦇Obj⦈" 
        "b ∈∘ 𝔅⦇Obj⦈"
        "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      from prems(2-4) show "F ∈∘ Vset α"
        unfolding prems(1) by (cs_concl cs_intro: cat_cs_intros V_cs_intros) 
    qed

    show "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (π”Š CF↓CF β„Œ) a b) ∈∘ Vset Ξ±"
      if "A βŠ†βˆ˜ π”Š CF↓CF β„Œβ¦‡Obj⦈"
        and "B βŠ†βˆ˜ π”Š CF↓CF β„Œβ¦‡Obj⦈"
        and "A ∈∘ Vset α"
        and "B ∈∘ Vset α"
      for A B
    proof-

      define A0 where "A0 = β„›βˆ˜ (Ξ»F∈∘A. F⦇0⦈)"
      define A1 where "A1 = β„›βˆ˜ (Ξ»F∈∘A. F⦇1β„•β¦ˆ)"
      define B0 where "B0 = β„›βˆ˜ (Ξ»F∈∘B. F⦇0⦈)"
      define B1 where "B1 = β„›βˆ˜ (Ξ»F∈∘B. F⦇1β„•β¦ˆ)"

      define A0B0 where "A0B0 = (β‹ƒβˆ˜a∈∘A0. β‹ƒβˆ˜b∈∘B0. Hom 𝔄 a b)"
      define A1B1 where "A1B1 = (β‹ƒβˆ˜a∈∘A1. β‹ƒβˆ˜b∈∘B1. Hom 𝔅 a b)"

      have A0B0: "A0B0 ∈∘ Vset α"
        unfolding A0B0_def
      proof(rule π”Š.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
        show "A0 ∈∘ Vset α"
          unfolding A0_def
        proof(intro vrange_vprojection_in_VsetI that(3))
          fix F assume "F ∈∘ A"
          with that(1) have "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]∘" by auto
          show "vsv F" unfolding F_def by auto
          show "0 ∈∘ π’Ÿβˆ˜ F" unfolding F_def by simp
        qed auto
        show "B0 ∈∘ Vset α"
          unfolding B0_def
        proof(intro vrange_vprojection_in_VsetI that(4))
          fix F assume "F ∈∘ B"
          with that(2) have "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]∘" by auto
          show "vsv F" unfolding F_def by auto
          show "0 ∈∘ π’Ÿβˆ˜ F" unfolding F_def by simp
        qed auto
      next
        fix a assume "a ∈∘ A0"
        with that(1) obtain F 
          where a_def: "a = F⦇0⦈" and "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" 
          unfolding A0_def by force
        with assms obtain b f where "F = [a, b, f]∘" and "a ∈∘ 𝔄⦇Obj⦈" by auto
        then show "a ∈∘ 𝔄⦇Obj⦈" unfolding a_def by simp
      next
        fix a assume "a ∈∘ B0"
        with that(2) obtain F 
          where a_def: "a = F⦇0⦈" and "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" 
          unfolding B0_def by force
        with assms obtain b f where "F = [a, b, f]∘" and "a ∈∘ 𝔄⦇Obj⦈" by auto
        then show "a ∈∘ 𝔄⦇Obj⦈" unfolding a_def by simp
      qed

      have A1B1: "A1B1 ∈∘ Vset α"
        unfolding A1B1_def
      proof(rule 𝔉.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
        show "A1 ∈∘ Vset α"
          unfolding A1_def
        proof(intro vrange_vprojection_in_VsetI that(3))
          fix F assume "F ∈∘ A"
          with that(1) have "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]∘" by auto
          show "vsv F" unfolding F_def by auto
          show "1β„• ∈∘ π’Ÿβˆ˜ F" unfolding F_def by (simp add: nat_omega_simps)
        qed auto
        show "B1 ∈∘ Vset α"
          unfolding B1_def
        proof(intro vrange_vprojection_in_VsetI that(4))
          fix F assume "F ∈∘ B"
          with that(2) have "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]∘" by auto
          show "vsv F" unfolding F_def by auto
          show "1β„• ∈∘ π’Ÿβˆ˜ F" unfolding F_def by (simp add: nat_omega_simps)
        qed auto
      next
        fix b assume "b ∈∘ A1"
        with that(1) obtain F 
          where b_def: "b = F⦇1β„•β¦ˆ" and "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" 
          unfolding A1_def by force
        with assms obtain a f where "F = [a, b, f]∘" and "b ∈∘ 𝔅⦇Obj⦈" 
          by (auto simp: nat_omega_simps)
        then show "b ∈∘ 𝔅⦇Obj⦈" unfolding b_def by simp
      next
        fix b assume "b ∈∘ B1"
        with that(2) obtain F 
          where b_def: "b = F⦇1β„•β¦ˆ" and "F ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" 
          unfolding B1_def by force
        with assms obtain a f where "F = [a, b, f]∘" and "b ∈∘ 𝔅⦇Obj⦈" 
          by (auto simp: nat_omega_simps)
        then show "b ∈∘ 𝔅⦇Obj⦈" unfolding b_def by simp
      qed
      
      define Q where 
        "Q i = (if i = 0 then A else if i = 1β„• then B else (A0B0 Γ—βˆ™ A1B1))" 
        for i
      have 
        "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B.
          Hom (π”Š CF↓CF β„Œ) a b) βŠ†βˆ˜ (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
      proof
        (
          intro vsubsetI,
          elim vifunionE,
          unfold in_Hom_iff,
          intro vproductI ballI
        )
        fix abf a'b'f' F assume prems: 
          "abf ∈∘ A" "a'b'f' ∈∘ B" "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
        from prems(3) assms obtain a b f a' b' f' g h
          where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
            and abf_def: "abf = [a, b, f]∘"
            and a'b'f'_def: "a'b'f' = [a', b', f']∘"
            and g: "g : a ↦𝔄 a'"
            and h: "h : b ↦𝔅 b'"
            and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
            and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
            and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
          by auto
        have gh: "[g, h]∘ ∈∘ A0B0 Γ—βˆ™ A1B1"
          unfolding A0B0_def A1B1_def 
        proof
          (
            intro ftimesI2 vifunionI, 
            unfold in_Hom_iff A0_def B0_def A1_def B1_def
          )
          from prems(1) show "a ∈∘ β„›βˆ˜ (Ξ»F∈∘A. F⦇0⦈)"
            by (intro vsv.vsv_vimageI2'[where a=abf]) (simp_all add: abf_def)
          from prems(2) show "a' ∈∘ β„›βˆ˜ (Ξ»F∈∘B. F⦇0⦈)"
            by (intro vsv.vsv_vimageI2'[where a=a'b'f']) 
              (simp_all add: a'b'f'_def)
          from prems(1) show "b ∈∘ β„›βˆ˜ (Ξ»F∈∘A. F⦇1β„•β¦ˆ)"
            by (intro vsv.vsv_vimageI2'[where a=abf]) 
              (simp_all add: nat_omega_simps abf_def)
          from prems(2) show "b' ∈∘ β„›βˆ˜ (Ξ»F∈∘B. F⦇1β„•β¦ˆ)"
            by (intro vsv.vsv_vimageI2'[where a=a'b'f']) 
              (simp_all add: nat_omega_simps a'b'f'_def)
        qed (intro g h)+
        show "vsv F" unfolding F_def by auto
        show "π’Ÿβˆ˜ F = set {0, 1β„•, 2β„•}"
          by (simp add: F_def three nat_omega_simps)
        fix i assume "i ∈∘ set {0, 1β„•, 2β„•}"
        then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί | β€Ήi = 2β„•β€Ί by auto
        from this prems show "F⦇i⦈ ∈∘ Q i" 
          by cases
            (simp_all add: F_def Q_def gh abf_def a'b'f'_def nat_omega_simps)
      qed
      moreover have "(∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i) ∈∘ Vset Ξ±"
      proof(rule Limit_vproduct_in_VsetI)
        show "set {0, 1β„•, 2β„•} ∈∘ Vset Ξ±" by (cs_concl cs_intro: V_cs_intros)
        from A0B0 A1B1 assms(1,2) that(3,4) show 
          "Q i ∈∘ Vset Ξ±" if "i ∈∘ set {0, 1β„•, 2β„•}" 
          for i 
          by (simp_all add: Q_def Limit_ftimes_in_VsetI nat_omega_simps)
      qed auto
      ultimately show "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (π”Š CF↓CF β„Œ) a b) ∈∘ Vset Ξ±" by auto
    qed
  qed (auto simp: cat_comma_cs_simps intro: cat_comma_cs_intros)

qed


subsubsectionβ€ΉTiny comma categoryβ€Ί

lemma tiny_category_cat_comma[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦C.tmΞ± β„­" and "β„Œ : 𝔅 ↦↦C.tmΞ± β„­"
  shows "tiny_category Ξ± (π”Š CF↓CF β„Œ)"
proof-

  interpret π”Š: is_tm_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret β„Œ: is_tm_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))
  note π”Š = π”Š.is_functor_axioms 
    and β„Œ = β„Œ.is_functor_axioms
  interpret category Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)

  show ?thesis
  proof(intro tiny_categoryI' category_cat_comma)
    have vrange_π”Š: "β„›βˆ˜ (π”Šβ¦‡ObjMap⦈) ∈∘ Vset Ξ±"
      by (simp add: vrange_in_VsetI π”Š.tm_cf_ObjMap_in_Vset)
    moreover have vrange_β„Œ: "β„›βˆ˜ (β„Œβ¦‡ObjMap⦈) ∈∘ Vset Ξ±"
      by (simp add: vrange_in_VsetI β„Œ.tm_cf_ObjMap_in_Vset)
    ultimately have UU_Hom_in_Vset:
      "(β‹ƒβˆ˜aβˆˆβˆ˜β„›βˆ˜ (π”Šβ¦‡ObjMap⦈). β‹ƒβˆ˜bβˆˆβˆ˜β„›βˆ˜ (β„Œβ¦‡ObjMap⦈). Hom β„­ a b) ∈∘ Vset Ξ±"
      using π”Š.cf_ObjMap_vrange β„Œ.cf_ObjMap_vrange 
      by (auto intro: π”Š.HomCod.cat_Hom_vifunion_in_Vset) 
    define Q where
      "Q i =
        (
          if i = 0
          then 𝔄⦇Obj⦈
          else
            if i = 1β„•
            then 𝔅⦇Obj⦈
            else (β‹ƒβˆ˜aβˆˆβˆ˜β„›βˆ˜ (π”Šβ¦‡ObjMap⦈). β‹ƒβˆ˜bβˆˆβˆ˜β„›βˆ˜ (β„Œβ¦‡ObjMap⦈). Hom β„­ a b)
        )" 
      for i
    have "π”Š CF↓CF β„Œβ¦‡Obj⦈ βŠ†βˆ˜ (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
    proof(intro vsubsetI)
      fix A assume "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
      then obtain a b f
        where A_def: "A = [a, b, f]∘"
          and a: "a ∈∘ 𝔄⦇Obj⦈"
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and f: "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by (elim cat_comma_ObjE[OF _ π”Š β„Œ])
      from f have f:
        "f ∈∘ (β‹ƒβˆ˜aβˆˆβˆ˜β„›βˆ˜ (π”Šβ¦‡ObjMap⦈). β‹ƒβˆ˜bβˆˆβˆ˜β„›βˆ˜ (β„Œβ¦‡ObjMap⦈). Hom β„­ a b)"
        by (intro vifunionI, unfold in_Hom_iff)
          (
            simp_all add: 
              a b 
              β„Œ.ObjMap.vsv_vimageI2 
              β„Œ.cf_ObjMap_vdomain 
              π”Š.ObjMap.vsv_vimageI2 
              π”Š.cf_ObjMap_vdomain
          )
      show "A ∈∘ (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
      proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
        show "π’Ÿβˆ˜ A = set {0, 1β„•, 2β„•}"
          unfolding A_def by (simp add: three nat_omega_simps)
        fix i assume "i ∈∘ set {0, 1β„•, 2β„•}"
        then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί | β€Ήi = 2β„•β€Ί by auto
        from this a b f show "A⦇i⦈ ∈∘ Q i"
          unfolding A_def Q_def by cases (simp_all add: nat_omega_simps)
      qed (auto simp: A_def)
    qed
    moreover have "(∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i) ∈∘ Vset Ξ±"
    proof(rule Limit_vproduct_in_VsetI)
      show "set {0, 1β„•, 2β„•} ∈∘ Vset Ξ±"
        unfolding three[symmetric] by simp
      from this show "Q i ∈∘ Vset Ξ±" if "i ∈∘ set {0, 1β„•, 2β„•}" for i
        using that assms(1,2) UU_Hom_in_Vset  
        by 
          (
            simp_all add:
              Q_def 
              π”Š.HomDom.tiny_cat_Obj_in_Vset 
              β„Œ.HomDom.tiny_cat_Obj_in_Vset 
              nat_omega_simps
          )
    qed auto
    ultimately show [simp]: "π”Š CF↓CF β„Œβ¦‡Obj⦈ ∈∘ Vset Ξ±" by auto 
    define Q where
      "Q i =
        (
          if i = 0
          then π”Š CF↓CF β„Œβ¦‡Obj⦈
          else
            if i = 1β„•
            then π”Š CF↓CF β„Œβ¦‡Obj⦈
            else 𝔄⦇Arr⦈ Γ—βˆ™ 𝔅⦇Arr⦈
        )" 
    for i
    have "π”Š CF↓CF β„Œβ¦‡Arr⦈ βŠ†βˆ˜ (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
    proof(intro vsubsetI)
      fix F assume "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
      then obtain abf a'b'f' where F: "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'"
        by (auto intro: is_arrI)
      with assms obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
          and abf_def: "abf = [a, b, f]∘"
          and a'b'f'_def: "a'b'f' = [a', b', f']∘"
          and g: "g : a ↦𝔄 a'"
          and h: "h : b ↦𝔅 b'"
          and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
          and "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
          and "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
        by auto
      from g h have "[g, h]∘ ∈∘ 𝔄⦇Arr⦈ Γ—βˆ™ 𝔅⦇Arr⦈" by auto      
      show "F ∈∘ (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
      proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
        show "π’Ÿβˆ˜ F = set {0, 1β„•, 2β„•}"
          by (simp add: F_def three nat_omega_simps)
        fix i assume "i ∈∘ set {0, 1β„•, 2β„•}"
        then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί | β€Ήi = 2β„•β€Ί by auto
        from this F g h show "F⦇i⦈ ∈∘ Q i"
          unfolding Q_def F_def abf_def[symmetric] a'b'f'_def[symmetric]
          by cases (auto simp: nat_omega_simps)
      qed (auto simp: F_def)
    qed
    moreover have "(∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i) ∈∘ Vset Ξ±"
    proof(rule Limit_vproduct_in_VsetI)
      show "set {0, 1β„•, 2β„•} ∈∘ Vset Ξ±"
        by (simp add: three[symmetric] nat_omega_simps)
      moreover have "𝔄⦇Arr⦈ Γ—βˆ™ 𝔅⦇Arr⦈ ∈∘ Vset Ξ±"
        by 
          (
            auto intro!: 
              Limit_ftimes_in_VsetI 
              π”Š.𝒡_Ξ² 𝒡_def 
              π”Š.HomDom.tiny_cat_Arr_in_Vset 
              β„Œ.HomDom.tiny_cat_Arr_in_Vset
          )
      ultimately show "Q i ∈∘ Vset Ξ±" if "i ∈∘ set {0, 1β„•, 2β„•}" for i
        using that assms(1,2) UU_Hom_in_Vset  
        by 
          (
            simp_all add:
              Q_def
              π”Š.HomDom.tiny_cat_Obj_in_Vset 
              β„Œ.HomDom.tiny_cat_Obj_in_Vset 
              nat_omega_simps
          )
    qed auto
    ultimately show "π”Š CF↓CF β„Œβ¦‡Arr⦈ ∈∘ Vset Ξ±" by auto
  qed (rule π”Š, rule β„Œ)

qed



subsectionβ€ΉProjections for a comma categoryβ€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-6 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_comma_proj_left :: "V ⇒ V ⇒ V" (‹(_ CF⨅ _)› [1000, 1000] 999)
  where "π”Š CFβ¨… β„Œ =
    [
      (Ξ»aβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Obj⦈. a⦇0⦈),
      (Ξ»fβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Arr⦈. f⦇2β„•β¦ˆβ¦‡0⦈),
      π”Š CF↓CF β„Œ,
      π”Šβ¦‡HomDom⦈
    ]∘"

definition cf_comma_proj_right :: "V β‡’ V β‡’ V" (β€Ή(_ β¨…CF _)β€Ί [1000, 1000] 999)
  where "π”Š β¨…CF β„Œ =
    [
      (Ξ»aβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Obj⦈. a⦇1β„•β¦ˆ),
      (Ξ»fβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Arr⦈. f⦇2β„•β¦ˆβ¦‡1β„•β¦ˆ),
      π”Š CF↓CF β„Œ,
      β„Œβ¦‡HomDom⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_comma_proj_left_components:
  shows "π”Š CFβ¨… β„Œβ¦‡ObjMap⦈ = (Ξ»aβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Obj⦈. a⦇0⦈)"
    and "π”Š CFβ¨… β„Œβ¦‡ArrMap⦈ = (Ξ»fβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Arr⦈. f⦇2β„•β¦ˆβ¦‡0⦈)"
    and "π”Š CFβ¨… β„Œβ¦‡HomDom⦈ = π”Š CF↓CF β„Œ"
    and "π”Š CFβ¨… β„Œβ¦‡HomCod⦈ = π”Šβ¦‡HomDom⦈"
  unfolding cf_comma_proj_left_def dghm_field_simps
  by (simp_all add: nat_omega_simps)

lemma cf_comma_proj_right_components:
  shows "π”Š β¨…CF β„Œβ¦‡ObjMap⦈ = (Ξ»aβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Obj⦈. a⦇1β„•β¦ˆ)"
    and "π”Š β¨…CF β„Œβ¦‡ArrMap⦈ = (Ξ»fβˆˆβˆ˜π”Š CF↓CF β„Œβ¦‡Arr⦈. f⦇2β„•β¦ˆβ¦‡1β„•β¦ˆ)"
    and "π”Š β¨…CF β„Œβ¦‡HomDom⦈ = π”Š CF↓CF β„Œ"
    and "π”Š β¨…CF β„Œβ¦‡HomCod⦈ = β„Œβ¦‡HomDom⦈"
  unfolding cf_comma_proj_right_def dghm_field_simps
  by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔄 𝔅 β„­ π”Š β„Œ
  assumes π”Š: "π”Š : 𝔄 ↦↦CΞ± β„­"
    and β„Œ: "β„Œ : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Š: is_functor Ξ± 𝔄 β„­ π”Š by (rule π”Š)
interpretation β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule β„Œ)

lemmas cf_comma_proj_left_components' = 
  cf_comma_proj_left_components[of π”Š β„Œ, unfolded π”Š.cf_HomDom]

lemmas cf_comma_proj_right_components' = 
  cf_comma_proj_right_components[of π”Š β„Œ, unfolded β„Œ.cf_HomDom]

lemmas [cat_comma_cs_simps] = 
  cf_comma_proj_left_components'(3,4)
  cf_comma_proj_right_components'(3,4)

end


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda cf_comma_proj_left_components(1)
  |vsv cf_comma_proj_left_ObjMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_left_ObjMap_vdomain[cat_comma_cs_simps]|

mk_VLambda cf_comma_proj_right_components(1)
  |vsv cf_comma_proj_right_ObjMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_right_ObjMap_vdomain[cat_comma_cs_simps]|

lemma cf_comma_proj_left_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a, b, f]∘" and "[a, b, f]∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  shows "π”Š CFβ¨… β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ = a"
  using assms(2) unfolding assms(1) cf_comma_proj_left_components by simp

lemma cf_comma_proj_right_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a, b, f]∘" and "[a, b, f]∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  shows "π”Š β¨…CF β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ = b"
  using assms(2)
  unfolding assms(1) cf_comma_proj_right_components 
  by (simp add: nat_omega_simps)

lemma cf_comma_proj_left_ObjMap_vrange:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (π”Š CFβ¨… β„Œβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔄⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  fix A assume prems: "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  with assms obtain a b f where A_def: "A = [a, b, f]∘" and a: "a ∈∘ 𝔄⦇Obj⦈"
    by auto
  from assms prems a show "π”Š CFβ¨… β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ ∈∘ 𝔄⦇Obj⦈"
    unfolding A_def by (cs_concl cs_simp: cat_comma_cs_simps)
qed (auto intro: cat_comma_cs_intros)  

lemma cf_comma_proj_right_ObjMap_vrange:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (π”Š β¨…CF β„Œβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔅⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  fix A assume prems: "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈"
  with assms obtain a b f where A_def: "A = [a, b, f]∘" and b: "b ∈∘ 𝔅⦇Obj⦈"
    by auto
  from assms prems b show "π”Š β¨…CF β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ ∈∘ 𝔅⦇Obj⦈"
    unfolding A_def by (cs_concl cs_simp: cat_comma_cs_simps)
qed (auto intro: cat_comma_cs_intros)  


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda cf_comma_proj_left_components(2)
  |vsv cf_comma_proj_left_ArrMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_left_ArrMap_vdomain[cat_comma_cs_simps]|

mk_VLambda cf_comma_proj_right_components(2)
  |vsv cf_comma_proj_right_ArrMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_right_ArrMap_vdomain[cat_comma_cs_simps]|

lemma cf_comma_proj_left_ArrMap_app[cat_comma_cs_simps]:
  assumes "A = [abf, a'b'f', [g, h]∘]∘" 
    and "[abf, a'b'f', [g, h]∘]∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  shows "π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡A⦈ = g"
  using assms(2)
  unfolding assms(1) cf_comma_proj_left_components 
  by (simp add: nat_omega_simps)

lemma cf_comma_proj_right_ArrMap_app[cat_comma_cs_simps]:
  assumes "A = [abf, a'b'f', [g, h]∘]∘" 
    and "[abf, a'b'f', [g, h]∘]∘ ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  shows "π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡A⦈ = h"
  using assms(2)
  unfolding assms(1) cf_comma_proj_right_components 
  by (simp add: nat_omega_simps)

lemma cf_comma_proj_left_ArrMap_vrange:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (π”Š CFβ¨… β„Œβ¦‡ArrMap⦈) βŠ†βˆ˜ 𝔄⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  from assms interpret category Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  fix F assume prems: "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  then obtain abf a'b'f' where "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'" by auto
  with assms obtain a b f a' b' f' g h
    where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
      and g: "g : a ↦𝔄 a'"
    by auto
  from assms prems g show "π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈ ∈∘ 𝔄⦇Arr⦈"
    unfolding F_def 
    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_comma_cs_intros)  

lemma cf_comma_proj_right_ArrMap_vrange:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (π”Š β¨…CF β„Œβ¦‡ArrMap⦈) βŠ†βˆ˜ 𝔅⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  from assms interpret category Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  fix F assume prems: "F ∈∘ π”Š CF↓CF β„Œβ¦‡Arr⦈"
  then obtain abf a'b'f' where F: "F : abf β†¦π”Š CF↓CF β„Œ a'b'f'" by auto
  with assms obtain a b f a' b' f' g h
    where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
      and h: "h : b ↦𝔅 b'"
    by auto
  from assms prems h show "π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈ ∈∘ 𝔅⦇Arr⦈"
    unfolding F_def 
    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_comma_cs_intros)  


subsubsectionβ€ΉProjections for a comma category are functorsβ€Ί

lemma cf_comma_proj_left_is_functor:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "π”Š CFβ¨… β„Œ : π”Š CF↓CF β„Œ ↦↦CΞ± 𝔄"
proof-
  interpret π”Š: is_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))
  from assms interpret π”Šβ„Œ: category Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  show ?thesis
  proof(rule is_functorI')
    show "vfsequence (π”Š CFβ¨… β„Œ)"
      unfolding cf_comma_proj_left_def by auto
    show "vcard (π”Š CFβ¨… β„Œ) = 4β„•"
      unfolding cf_comma_proj_left_def by (simp add: nat_omega_simps)
    from assms show "β„›βˆ˜ (π”Š CFβ¨… β„Œβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔄⦇Obj⦈"
      by (rule cf_comma_proj_left_ObjMap_vrange)
    show "π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈ : π”Š CFβ¨… β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ ↦𝔄 π”Š CFβ¨… β„Œβ¦‡ObjMapβ¦ˆβ¦‡B⦈"
      if "F : A β†¦π”Š CF↓CF β„Œ B" for A B F
    proof-
      from assms that obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
          and A_def: "A = [a, b, f]∘"
          and B_def: "B = [a', b', f']∘"
          and g: "g : a ↦𝔄 a'"
        by auto
      from that g show 
        "π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈ : π”Š CFβ¨… β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ ↦𝔄 π”Š CFβ¨… β„Œβ¦‡ObjMapβ¦ˆβ¦‡B⦈"
        unfolding F_def A_def B_def
        by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
    qed
    show 
      "π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡G ∘Aπ”Š CF↓CF β„Œ F⦈ =
        π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡G⦈ ∘A𝔄 π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈"
      if "G : B β†¦π”Š CF↓CF β„Œ C" and "F : A β†¦π”Š CF↓CF β„Œ B" for B C G A F
    proof-
      from assms that(2) obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
          and A_def: "A = [a, b, f]∘"
          and B_def: "B = [a', b', f']∘"
          and g: "g : a ↦𝔄 a'"
          and h: "h : b ↦𝔅 b'"
          and f: "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
          and f': "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
          and [cat_cs_simps]: "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
        by auto
      with that(1) assms obtain a'' b'' f'' g' h'
        where G_def: "G = [[a', b', f']∘, [a'', b'', f'']∘, [g', h']∘]∘"
          and C_def: "C = [a'', b'', f'']∘"
          and g': "g' : a' ↦𝔄 a''"
          and h': "h' : b' ↦𝔅 b''"
          and f'': "f'' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a''⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
          and [cat_cs_simps]: "f'' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'"
        by auto (*slow*)
      note [cat_cs_simps] = 
        category.cat_assoc_helper
          [
            where β„­=β„­ 
              and h=f'' 
              and g=β€Ήπ”Šβ¦‡ArrMapβ¦ˆβ¦‡g'β¦ˆβ€Ί 
              and q=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β€Ί
          ]
        category.cat_assoc_helper
          [
            where β„­=β„­ 
              and h=f 
              and g=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡hβ¦ˆβ€Ί 
              and q=β€Ήf' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡gβ¦ˆβ€Ί
          ]
      from assms that g g' h h' f f' f'' show ?thesis
        unfolding F_def G_def A_def B_def C_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
    show "π”Š CFβ¨… β„Œβ¦‡ArrMapβ¦ˆβ¦‡π”Š CF↓CF β„Œβ¦‡CIdβ¦ˆβ¦‡A⦈⦈ = 𝔄⦇CIdβ¦ˆβ¦‡π”Š CFβ¨… β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈⦈"
      if "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" for A
    proof-
      from assms that obtain a b f 
        where A_def: "A = [a, b, f]∘"
          and "a ∈∘ 𝔄⦇Obj⦈" 
          and "b ∈∘ 𝔅⦇Obj⦈" 
          and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by auto
      from assms that this(2-4) show ?thesis
        unfolding A_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
  qed 
    (
      use assms in 
        β€Ή
          cs_concl
            cs_simp: cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
        β€Ί
    )+
qed

lemma cf_comma_proj_left_is_functor'[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "𝔄' = π”Š CF↓CF β„Œ"
  shows "π”Š CFβ¨… β„Œ : 𝔄' ↦↦CΞ± 𝔄"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_functor)

lemma cf_comma_proj_right_is_functor:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­" and "β„Œ : 𝔅 ↦↦CΞ± β„­"
  shows "π”Š β¨…CF β„Œ : π”Š CF↓CF β„Œ ↦↦CΞ± 𝔅"
proof-
  interpret π”Š: is_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))
  from assms interpret π”Šβ„Œ: category Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  show ?thesis
  proof(rule is_functorI')
    show "vfsequence (π”Š β¨…CF β„Œ)"
      unfolding cf_comma_proj_right_def by auto
    show "vcard (π”Š β¨…CF β„Œ) = 4β„•"
      unfolding cf_comma_proj_right_def by (simp add: nat_omega_simps)
    from assms show "β„›βˆ˜ (π”Š β¨…CF β„Œβ¦‡ObjMap⦈) βŠ†βˆ˜ 𝔅⦇Obj⦈"
      by (rule cf_comma_proj_right_ObjMap_vrange)
    show "π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈ : π”Š β¨…CF β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ ↦𝔅 π”Š β¨…CF β„Œβ¦‡ObjMapβ¦ˆβ¦‡B⦈"
      if "F : A β†¦π”Š CF↓CF β„Œ B" for A B F
    proof-
      from assms that obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
          and A_def: "A = [a, b, f]∘"
          and B_def: "B = [a', b', f']∘"
          and h: "h : b ↦𝔅 b'"
        by auto
      from that h show 
        "π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈ : π”Š β¨…CF β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈ ↦𝔅 π”Š β¨…CF β„Œβ¦‡ObjMapβ¦ˆβ¦‡B⦈"
        unfolding F_def A_def B_def
        by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
    qed
    show 
      "π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡G ∘Aπ”Š CF↓CF β„Œ F⦈ =
        π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡G⦈ ∘A𝔅 π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡F⦈"
      if "G : B β†¦π”Š CF↓CF β„Œ C" and "F : A β†¦π”Š CF↓CF β„Œ B" for B C G A F
    proof-
      from assms that(2) obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f]∘, [a', b', f']∘, [g, h]∘]∘"
          and A_def: "A = [a, b, f]∘"
          and B_def: "B = [a', b', f']∘"
          and g: "g : a ↦𝔄 a'"
          and h: "h : b ↦𝔅 b'"
          and f: "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
          and f': "f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
          and [cat_cs_simps]: "f' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h⦈ ∘Aβ„­ f"
        by auto
      with that(1) assms obtain a'' b'' f'' g' h'
        where G_def: "G = [[a', b', f']∘, [a'', b'', f'']∘, [g', h']∘]∘"
          and C_def: "C = [a'', b'', f'']∘"
          and g': "g' : a' ↦𝔄 a''"
          and h': "h' : b' ↦𝔅 b''"
          and f'': "f'' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a''⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
          and [cat_cs_simps]: "f'' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g'⦈ = β„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'"
        by auto (*slow*)
      note [cat_cs_simps] = 
        category.cat_assoc_helper
          [
            where β„­=β„­ 
              and h=f'' 
              and g=β€Ήπ”Šβ¦‡ArrMapβ¦ˆβ¦‡g'β¦ˆβ€Ί 
              and q=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β€Ί
          ]
        category.cat_assoc_helper
          [
            where β„­=β„­ 
              and h=f 
              and g=β€Ήβ„Œβ¦‡ArrMapβ¦ˆβ¦‡hβ¦ˆβ€Ί 
              and q=β€Ήf' ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡gβ¦ˆβ€Ί
          ]
      from assms that g g' h h' f f' f'' show ?thesis
        unfolding F_def G_def A_def B_def C_def
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
    show "π”Š β¨…CF β„Œβ¦‡ArrMapβ¦ˆβ¦‡π”Š CF↓CF β„Œβ¦‡CIdβ¦ˆβ¦‡A⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”Š β¨…CF β„Œβ¦‡ObjMapβ¦ˆβ¦‡A⦈⦈"
      if "A ∈∘ π”Š CF↓CF β„Œβ¦‡Obj⦈" for A
    proof-
      from assms that obtain a b f 
        where A_def: "A = [a, b, f]∘"
          and "a ∈∘ 𝔄⦇Obj⦈" 
          and "b ∈∘ 𝔅⦇Obj⦈" 
          and "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ β„Œβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by auto
      from assms that this(2-4) show ?thesis
        unfolding A_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
  qed 
    (
      use assms in
        β€Ή
          cs_concl
            cs_simp: cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
        β€Ί
    )+
qed

lemma cf_comma_proj_right_is_functor'[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦CΞ± β„­"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "𝔄' = π”Š CF↓CF β„Œ"
  shows "π”Š β¨…CF β„Œ : 𝔄' ↦↦CΞ± 𝔅"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_functor)


subsubsectionβ€ΉProjections for a tiny comma categoryβ€Ί

lemma cf_comma_proj_left_is_tm_functor:
  assumes "π”Š : 𝔄 ↦↦C.tmΞ± β„­" and "β„Œ : 𝔅 ↦↦C.tmΞ± β„­"
  shows "π”Š CFβ¨… β„Œ : π”Š CF↓CF β„Œ ↦↦C.tmΞ± 𝔄"
proof(intro is_tm_functorI')

  interpret π”Š: is_tm_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret β„Œ: is_tm_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))

  show Ξ _π”Šβ„Œ: "π”Š CFβ¨… β„Œ : π”Š CF↓CF β„Œ ↦↦CΞ± 𝔄"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)

  interpret Ξ _π”Šβ„Œ: is_functor Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί 𝔄 β€Ήπ”Š CFβ¨… β„Œβ€Ί
    by (rule Ξ _π”Šβ„Œ)
  interpret π”Šβ„Œ: tiny_category Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί 
    by (cs_concl cs_intro: cat_small_cs_intros cat_comma_cs_intros)

  show "π”Š CFβ¨… β„Œβ¦‡ObjMap⦈ ∈∘ Vset Ξ±"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "β„›βˆ˜ (π”Š CFβ¨… β„Œβ¦‡ObjMap⦈) ∈∘ Vset Ξ±"
    proof-
      note Ξ _π”Šβ„Œ.cf_ObjMap_vrange
      moreover have "𝔄⦇Obj⦈ ∈∘ Vset Ξ±" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)

  show "π”Š CFβ¨… β„Œβ¦‡ArrMap⦈ ∈∘ Vset Ξ±"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "β„›βˆ˜ (π”Š CFβ¨… β„Œβ¦‡ArrMap⦈) ∈∘ Vset Ξ±"
    proof-
      note Ξ _π”Šβ„Œ.cf_ArrMap_vrange
      moreover have "𝔄⦇Arr⦈ ∈∘ Vset Ξ±" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)

qed

lemma cf_comma_proj_left_is_tm_functor'[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦C.tmΞ± β„­" 
    and "β„Œ : 𝔅 ↦↦C.tmΞ± β„­"
    and "π”Šβ„Œ = π”Š CF↓CF β„Œ"
  shows "π”Š CFβ¨… β„Œ : π”Šβ„Œ ↦↦C.tmΞ± 𝔄"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_tm_functor)

lemma cf_comma_proj_right_is_tm_functor:
  assumes "π”Š : 𝔄 ↦↦C.tmΞ± β„­" and "β„Œ : 𝔅 ↦↦C.tmΞ± β„­"
  shows "π”Š β¨…CF β„Œ : π”Š CF↓CF β„Œ ↦↦C.tmΞ± 𝔅"
proof(intro is_tm_functorI')

  interpret π”Š: is_tm_functor Ξ± 𝔄 β„­ π”Š by (rule assms(1))
  interpret β„Œ: is_tm_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))

  show Ξ _π”Šβ„Œ: "π”Š β¨…CF β„Œ : π”Š CF↓CF β„Œ ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)

  interpret Ξ _π”Šβ„Œ: is_functor Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί 𝔅 β€Ήπ”Š β¨…CF β„Œβ€Ί
    by (rule Ξ _π”Šβ„Œ)
  interpret π”Šβ„Œ: tiny_category Ξ± β€Ήπ”Š CF↓CF β„Œβ€Ί 
    by (cs_concl cs_intro: cat_small_cs_intros cat_comma_cs_intros)

  show "π”Š β¨…CF β„Œβ¦‡ObjMap⦈ ∈∘ Vset Ξ±"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "β„›βˆ˜ (π”Š β¨…CF β„Œβ¦‡ObjMap⦈) ∈∘ Vset Ξ±"
    proof-
      note Ξ _π”Šβ„Œ.cf_ObjMap_vrange
      moreover have "𝔅⦇Obj⦈ ∈∘ Vset Ξ±" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)

  show "π”Š β¨…CF β„Œβ¦‡ArrMap⦈ ∈∘ Vset Ξ±"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "β„›βˆ˜ (π”Š β¨…CF β„Œβ¦‡ArrMap⦈) ∈∘ Vset Ξ±"
    proof-
      note Ξ _π”Šβ„Œ.cf_ArrMap_vrange
      moreover have "𝔅⦇Arr⦈ ∈∘ Vset Ξ±" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)

qed

lemma cf_comma_proj_right_is_tm_functor'[cat_comma_cs_intros]:
  assumes "π”Š : 𝔄 ↦↦C.tmΞ± β„­" 
    and "β„Œ : 𝔅 ↦↦C.tmΞ± β„­"
    and "π”Šβ„Œ = π”Š CF↓CF β„Œ"
  shows "π”Š β¨…CF β„Œ : π”Šβ„Œ ↦↦C.tmΞ± 𝔅"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_tm_functor)



subsectionβ€ΉComma categories constructed from a functor and an objectβ€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί


textβ€ΉSee Chapter II-6 in \cite{mac_lane_categories_2010}.β€Ί

definition cat_cf_obj_comma :: "V β‡’ V β‡’ V" (β€Ή(_ CF↓ _)β€Ί [1000, 1000] 999)
  where "𝔉 CF↓ b ≑ 𝔉 CF↓CF (cf_const (cat_1 0 0) (𝔉⦇HomCod⦈) b)"

definition cat_obj_cf_comma :: "V β‡’ V β‡’ V" (β€Ή(_ ↓CF _)β€Ί [1000, 1000] 999)
  where "b ↓CF 𝔉 ≑ (cf_const (cat_1 0 0) (𝔉⦇HomCod⦈) b) CF↓CF 𝔉"


textβ€ΉAlternative forms of the definitions.β€Ί

lemma (in is_functor) cat_cf_obj_comma_def:
  "𝔉 CF↓ b = 𝔉 CF↓CF (cf_const (cat_1 0 0) 𝔅 b)" 
  unfolding cat_cf_obj_comma_def cf_HomCod ..

lemma (in is_functor) cat_obj_cf_comma_def:
  "b ↓CF 𝔉 = (cf_const (cat_1 0 0) 𝔅 b) CF↓CF 𝔉" 
  unfolding cat_obj_cf_comma_def cf_HomCod ..


subsubsectionβ€ΉObjectsβ€Ί

lemma (in is_functor) cat_cf_obj_comma_ObjI[cat_comma_cs_intros]:
  assumes "A = [a, 0, f]∘" and "a ∈∘ 𝔄⦇Obj⦈" and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
  shows "A ∈∘ 𝔉 CF↓ b⦇Obj⦈"
  using assms(2,3)
  unfolding assms(1)
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_cf_obj_comma_def 
        cs_intro: cat_cs_intros vempty_is_zet cat_comma_ObjI
    )

lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ObjI

lemma (in is_functor) cat_obj_cf_comma_ObjI[cat_comma_cs_intros]:
  assumes "A = [0, a, f]∘" and "a ∈∘ 𝔄⦇Obj⦈" and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
  shows "A ∈∘ b ↓CF 𝔉⦇Obj⦈"
  using assms(2,3)
  unfolding assms(1)
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_obj_cf_comma_def 
        cs_intro: vempty_is_zet cat_cs_intros cat_comma_ObjI
    )

lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ObjI

lemma (in is_functor) cat_cf_obj_comma_ObjD[dest]:
  assumes "[a, b', f]∘ ∈∘ 𝔉 CF↓ b⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "a ∈∘ 𝔄⦇Obj⦈" 
    and "b' = 0" 
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  note obj = cat_comma_ObjD[
      OF assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this
      ]
  from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
  moreover have "cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈ = b"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show "a ∈∘ 𝔄⦇Obj⦈" "b' = 0" "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
    using obj by auto
qed

lemmas [dest] = is_functor.cat_cf_obj_comma_ObjD[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ObjD[dest]:
  assumes "[b', a, f]∘ ∈∘ b ↓CF 𝔉⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "a ∈∘ 𝔄⦇Obj⦈" 
    and "b' = 0" 
    and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  note obj = cat_comma_ObjD[
      OF assms(1)[unfolded cat_obj_cf_comma_def] this is_functor_axioms
      ]
  from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
  moreover have "cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈ = b"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show "a ∈∘ 𝔄⦇Obj⦈" "b' = 0" "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    using obj by auto
qed

lemmas [dest] = is_functor.cat_obj_cf_comma_ObjD[rotated 1]

lemma (in is_functor) cat_cf_obj_comma_ObjE[elim]:
  assumes "A ∈∘ 𝔉 CF↓ b⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  obtains a f where "A = [a, 0, f]∘" 
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this 
  obtain a b' f 
    where "A = [a, b', f]∘"
      and a: "a ∈∘ 𝔄⦇Obj⦈"
      and b': "b' ∈∘ cat_1 0 0⦇Obj⦈" 
      and f: "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈"
    by auto
  moreover from b' have [cat_cs_simps]: "b' = 0"
    unfolding cat_1_components by auto
  moreover have "cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈ = b"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show ?thesis using that by auto
qed

lemmas [elim] = is_functor.cat_cf_obj_comma_ObjE[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ObjE[elim]:
  assumes "A ∈∘ b ↓CF 𝔉⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  obtains a f where "A = [0, a, f]∘"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(1)[unfolded cat_obj_cf_comma_def] is_functor_axioms this 
  obtain a b' f 
    where A_def: "A = [b', a, f]∘"
      and a: "a ∈∘ 𝔄⦇Obj⦈"
      and b': "b' ∈∘ cat_1 0 0⦇Obj⦈" 
      and f: "f : cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    by auto
  moreover from b' have [cat_cs_simps]: "b' = 0" 
    unfolding cat_1_components by auto
  moreover have "cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈ = b"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show ?thesis using that by auto
qed

lemmas [elim] = is_functor.cat_obj_cf_comma_ObjE[rotated 1]


subsubsectionβ€ΉArrowsβ€Ί

lemma (in is_functor) cat_cf_obj_comma_ArrI[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" 
    and "F = [abf, a'b'f', [g, 0]∘]∘"
    and "abf = [a, 0, f]∘"
    and "a'b'f' = [a', 0, f']∘"
    and "g : a ↦𝔄 a'"
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
    and "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
    and "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f"
  shows "F ∈∘ 𝔉 CF↓ b⦇Arr⦈"
  unfolding cat_cf_obj_comma_def
proof(intro cat_comma_ArrI cat_comma_HomI)
  show "𝔉 : 𝔄 ↦↦CΞ± 𝔅" by (cs_concl cs_intro: cat_cs_intros)
  from assms(1) show const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from vempty_is_zet show 0: "0 : 0 ↦cat_1 0 0 0"
    by (cs_concl cs_simp: cat_cs_simps cat_1_CId_app cs_intro: cat_cs_intros)
  from assms(6) show 
    "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡0⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(7) show 
    "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡0⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 0 assms(6) show 
    "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = cf_const (cat_1 0 0) 𝔅 b⦇ArrMapβ¦ˆβ¦‡0⦈ ∘A𝔅 f"
    by (cs_concl cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros)
  from const assms(5,6) show 
    "abf ∈∘ 𝔉 CF↓CF (dghm_const (cat_1 []∘ []∘) 𝔅 b (𝔅⦇CIdβ¦ˆβ¦‡b⦈))⦇Obj⦈"
    by (fold cat_cf_obj_comma_def)
      (cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
  from const assms(5,7) show 
    "a'b'f' ∈∘ 𝔉 CF↓CF (dghm_const (cat_1 []∘ []∘) 𝔅 b (𝔅⦇CIdβ¦ˆβ¦‡b⦈))⦇Obj⦈"
    by (fold cat_cf_obj_comma_def)
      (cs_concl cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros)
qed (intro assms)+

lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ArrI

lemma (in is_functor) cat_obj_cf_comma_ArrI[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" 
    and "F = [abf, a'b'f', [0, g]∘]∘"
    and "abf = [0, a, f]∘"
    and "a'b'f' = [0, a', f']∘"
    and "g : a ↦𝔄 a'"
    and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ "
    and "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f = f'"
  shows "F ∈∘ b ↓CF 𝔉⦇Arr⦈"
  unfolding cat_obj_cf_comma_def
proof(intro cat_comma_ArrI cat_comma_HomI)
  show "𝔉 : 𝔄 ↦↦CΞ± 𝔅" by (cs_concl cs_intro: cat_cs_intros)
  from assms(1) show const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from vempty_is_zet show 0: "0 : 0 ↦cat_1 0 0 0"
    by (cs_concl cs_simp: cat_1_CId_app cs_intro: cat_cs_intros)
  from assms(6) show 
    "f : cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡0⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(7) show 
    "f' : cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡0⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 0 assms(7) show 
    "f' ∘A𝔅 cf_const (cat_1 0 0) 𝔅 b⦇ArrMapβ¦ˆβ¦‡0⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f"
    by (cs_concl cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros)
  from const assms(5,6) show 
    "abf ∈∘ (dghm_const (cat_1 0 0) 𝔅 b (𝔅⦇CIdβ¦ˆβ¦‡b⦈)) CF↓CF 𝔉⦇Obj⦈"
    by (fold cat_obj_cf_comma_def)
      (cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
  from const assms(5,7) show 
    "a'b'f' ∈∘ (dghm_const (cat_1 []∘ []∘) 𝔅 b (𝔅⦇CIdβ¦ˆβ¦‡b⦈)) CF↓CF 𝔉⦇Obj⦈"
    by (fold cat_obj_cf_comma_def)
      (cs_concl cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros)
qed (intro assms)+

lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ArrI

lemma (in is_functor) cat_cf_obj_comma_ArrE[elim]:
  assumes "F ∈∘ 𝔉 CF↓ b⦇Arr⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  obtains abf a'b'f' a f a' f' g
    where "F = [abf, a'b'f', [g, 0]∘]∘"
      and "abf = [a, 0, f]∘"
      and "a'b'f' = [a', 0, f']∘"
      and "g : a ↦𝔄 a'"
      and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
      and "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
      and "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f"
      and "abf ∈∘ 𝔉 CF↓ b⦇Obj⦈"
      and "a'b'f' ∈∘ 𝔉 CF↓ b⦇Obj⦈"
proof-
  from cat_comma_ArrE[OF assms(1)[unfolded cat_cf_obj_comma_def]] 
  obtain abf a'b'f' 
    where F: "F ∈∘ cat_comma_Hom 𝔉 (cf_const (cat_1 0 0) 𝔅 b) abf a'b'f'"
      and abf: "abf ∈∘ 𝔉 CF↓CF (cf_const (cat_1 0 0) 𝔅 b)⦇Obj⦈"
      and a'b'f': "a'b'f' ∈∘ 𝔉 CF↓CF (cf_const (cat_1 0 0) 𝔅 b)⦇Obj⦈"
    by auto
  from assms(2) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from F obtain a b'' f a' b' f' g h
    where F_def: "F = [abf, a'b'f', [g, h]∘]∘"
      and abf_def: "abf = [a, b'', f]∘"
      and a'b'f'_def: "a'b'f' = [a', b', f']∘"
      and g: "g : a ↦𝔄 a'"
      and h: "h : b'' ↦cat_1 0 0 b'"
      and f: "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b''⦈"
      and f': "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈"
      and f_def: 
        "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = cf_const (cat_1 0 0) 𝔅 b⦇ArrMapβ¦ˆβ¦‡h⦈ ∘A𝔅 f"
    by (elim cat_comma_HomE[OF _ is_functor_axioms const]) blast
  note hb'b'' = cat_1_is_arrD[OF h]
  from F_def have F_def: "F = [abf, a'b'f', [g, 0]∘]∘" 
    unfolding hb'b'' by simp
  from abf_def have abf_def: "abf = [a, 0, f]∘"
    unfolding hb'b'' by simp
  from a'b'f'_def have a'b'f'_def: "a'b'f' = [a', 0, f']∘"
    unfolding hb'b'' by simp
  from f have f: "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
    unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f' have f': "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
    unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f_def f f' g h have f_def: "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f"
    unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 
    that F_def abf_def a'b'f'_def g f f' f_def  
    a'b'f'[folded cat_cf_obj_comma_def] abf[folded cat_cf_obj_comma_def]
  show ?thesis
    by blast
qed

lemmas [elim] = is_functor.cat_cf_obj_comma_ArrE[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ArrE[elim]:
  assumes "F ∈∘ b ↓CF 𝔉⦇Arr⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  obtains baf b'a'f' a f a' f' g
    where "F = [baf, b'a'f', [0, g]∘]∘"
      and "baf = [0, a, f]∘"
      and "b'a'f' = [0, a', f']∘"
      and "g : a ↦𝔄 a'"
      and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      and "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
      and "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f = f'"
      and "baf ∈∘ b ↓CF 𝔉⦇Obj⦈"
      and "b'a'f' ∈∘ b ↓CF 𝔉⦇Obj⦈"
proof-
  from cat_comma_ArrE[OF assms(1)[unfolded cat_obj_cf_comma_def]] 
  obtain baf b'a'f' 
    where F: "F ∈∘ cat_comma_Hom (cf_const (cat_1 0 0) 𝔅 b) 𝔉 baf b'a'f'"
      and baf: "baf ∈∘ (cf_const (cat_1 0 0) 𝔅 b) CF↓CF 𝔉⦇Obj⦈"
      and b'a'f': "b'a'f' ∈∘ (cf_const (cat_1 0 0) 𝔅 b) CF↓CF 𝔉⦇Obj⦈"
    by auto
  from assms(2) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from F obtain a b'' f a' b' f' h g 
    where F_def: "F = [baf, b'a'f', [h, g]∘]∘"
      and baf_def: "baf = [b', a, f]∘"
      and b'a'f'_def: "b'a'f' = [b'', a', f']∘"
      and h: "h : b' ↦cat_1 0 0 b''"
      and g: "g : a ↦𝔄 a'"
      and f: "f : cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b'⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      and f': "f' : cf_const (cat_1 0 0) 𝔅 b⦇ObjMapβ¦ˆβ¦‡b''⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
      and f'_def: 
        "f' ∘A𝔅 cf_const (cat_1 0 0) 𝔅 b⦇ArrMapβ¦ˆβ¦‡h⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f"
    by (elim cat_comma_HomE[OF _ const is_functor_axioms]) blast
  note hb'b'' = cat_1_is_arrD[OF h]
  from F_def have F_def: "F = [baf, b'a'f', [0, g]∘]∘" 
    unfolding hb'b'' by simp
  from baf_def have baf_def: "baf = [0, a, f]∘" 
    unfolding hb'b'' by simp
  from b'a'f'_def have b'a'f'_def: "b'a'f' = [0, a', f']∘"
    unfolding hb'b'' by simp
  from f have f: "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f' have f': "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
    unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f'_def f f' g h have f'_def[symmetric]: "f' = 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f"
    unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 
    that F_def baf_def b'a'f'_def g f f' f'_def  
    baf[folded cat_obj_cf_comma_def] b'a'f'[folded cat_obj_cf_comma_def] 
  show ?thesis
    by blast
qed

lemmas [elim] = is_functor.cat_obj_cf_comma_ArrE

lemma (in is_functor) cat_cf_obj_comma_ArrD[dest]: 
  assumes "[[a, b', f]∘, [a', b'', f']∘, [g, h]∘]∘ ∈∘ 𝔉 CF↓ b⦇Arr⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "b' = 0"
    and "b'' = 0"
    and "h = 0"
    and "g : a ↦𝔄 a'"
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
    and "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
    and "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f"
    and "[a, b', f]∘ ∈∘ 𝔉 CF↓ b⦇Obj⦈"
    and "[a', b'', f']∘ ∈∘ 𝔉 CF↓ b⦇Obj⦈"
  using cat_cf_obj_comma_ArrE[OF assms] by auto

lemmas [dest] = is_functor.cat_cf_obj_comma_ArrD[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ArrD[dest]: 
  assumes "[[b', a, f]∘, [b'', a', f']∘, [h, g]∘]∘ ∈∘ b ↓CF 𝔉⦇Arr⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "b' = 0"
    and "b'' = 0"
    and "h = 0"
    and "g : a ↦𝔄 a'"
    and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
    and "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f = f'"
    and "[b', a, f]∘ ∈∘ b ↓CF 𝔉⦇Obj⦈"
    and "[b'', a', f']∘ ∈∘ b ↓CF 𝔉⦇Obj⦈"
  using cat_obj_cf_comma_ArrE[OF assms] by auto

lemmas [dest] = is_functor.cat_obj_cf_comma_ArrD


subsubsectionβ€ΉDomainβ€Ί

lemma cat_cf_obj_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF↓ b⦇Dom⦈)"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Dom_vdomain[cat_comma_cs_simps]:
  "π’Ÿβˆ˜ (𝔉 CF↓ b⦇Dom⦈) = 𝔉 CF↓ b⦇Arr⦈"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Dom_app[cat_comma_cs_simps]:
  assumes "F = [abf, a'b'f', gh]∘" and "F ∈∘ 𝔉 CF↓ b⦇Arr⦈"
  shows "𝔉 CF↓ b⦇Domβ¦ˆβ¦‡F⦈ = abf"
  using assms(2) 
  unfolding assms(1) cat_cf_obj_comma_def cat_comma_components 
  by simp

lemma (in is_functor) cat_cf_obj_comma_Dom_vrange:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "β„›βˆ˜ (𝔉 CF↓ b⦇Dom⦈) βŠ†βˆ˜ 𝔉 CF↓ b⦇Obj⦈"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Dom_vrange[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma cat_obj_cf_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (b ↓CF 𝔉⦇Dom⦈)"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Dom_vdomain[cat_comma_cs_simps]:
  "π’Ÿβˆ˜ (b ↓CF 𝔉⦇Dom⦈) = b ↓CF 𝔉⦇Arr⦈"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Dom_app[cat_comma_cs_simps]:
  assumes "F = [baf, b'a'f', gh]∘" and "F ∈∘ b ↓CF 𝔉⦇Arr⦈"
  shows "b ↓CF 𝔉⦇Domβ¦ˆβ¦‡F⦈ = baf"
  using assms(2)
  unfolding assms(1) cat_obj_cf_comma_def cat_comma_components 
  by simp

lemma (in is_functor) cat_obj_cf_comma_Dom_vrange:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "β„›βˆ˜ (b ↓CF 𝔉⦇Dom⦈) βŠ†βˆ˜ b ↓CF 𝔉⦇Obj⦈"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Dom_vrange[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed


subsubsectionβ€ΉCodomainβ€Ί

lemma cat_cf_obj_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF↓ b⦇Cod⦈)"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Cod_vdomain[cat_comma_cs_simps]:
  "π’Ÿβˆ˜ (𝔉 CF↓ b⦇Cod⦈) = 𝔉 CF↓ b⦇Arr⦈"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Cod_app[cat_comma_cs_simps]:
  assumes "F = [abf, a'b'f', gh]∘" and "F ∈∘ 𝔉 CF↓ b⦇Arr⦈"
  shows "𝔉 CF↓ b⦇Codβ¦ˆβ¦‡F⦈ = a'b'f'"
  using assms(2) 
  unfolding assms(1) cat_cf_obj_comma_def cat_comma_components 
  by (simp add: nat_omega_simps)

lemma (in is_functor) cat_cf_obj_comma_Cod_vrange:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "β„›βˆ˜ (𝔉 CF↓ b⦇Cod⦈) βŠ†βˆ˜ 𝔉 CF↓ b⦇Obj⦈"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Cod_vrange[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma cat_obj_cf_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (b ↓CF 𝔉⦇Cod⦈)"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Cod_vdomain[cat_comma_cs_simps]:
  "π’Ÿβˆ˜ (b ↓CF 𝔉⦇Cod⦈) = b ↓CF 𝔉⦇Arr⦈"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Cod_app[cat_comma_cs_simps]:
  assumes "F = [baf, b'a'f', gh]∘" and "F ∈∘ b ↓CF 𝔉⦇Arr⦈"
  shows "b ↓CF 𝔉⦇Codβ¦ˆβ¦‡F⦈ = b'a'f'"
  using assms(2)
  unfolding assms(1) cat_obj_cf_comma_def cat_comma_components 
  by (simp add: nat_omega_simps)

lemma (in is_functor) cat_obj_cf_comma_Cod_vrange:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "β„›βˆ˜ (b ↓CF 𝔉⦇Dom⦈) βŠ†βˆ˜ b ↓CF 𝔉⦇Obj⦈"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Dom_vrange[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma (in is_functor) cat_cf_obj_comma_is_arrI[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
    and "F = [abf, a'b'f', gh]∘"
    and "abf = [a, 0, f]∘"
    and "a'b'f' = [a', 0, f']∘"
    and "gh = [g, 0]∘"
    and "g : a ↦𝔄 a'"
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
    and "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
    and "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f"
  shows "F : abf ↦𝔉 CF↓ b a'b'f'"
proof(intro is_arrI)
  from assms(1,6,7,8) show "F ∈∘ 𝔉 CF↓ b⦇Arr⦈"
    by (cs_concl cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros)
  with assms(2) show "𝔉 CF↓ b⦇Domβ¦ˆβ¦‡F⦈ = abf" "𝔉 CF↓ b⦇Codβ¦ˆβ¦‡F⦈ = a'b'f'"
    by (cs_concl cs_simp: cat_comma_cs_simps)+
qed

lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_is_arrI

lemma (in is_functor) cat_obj_cf_comma_is_arrI[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
    and "F = [baf, b'a'f', gh]∘"
    and "baf = [0, a, f]∘"
    and "b'a'f' = [0, a', f']∘"
    and "gh = [0, g]∘"
    and "g : a ↦𝔄 a'"
    and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
    and "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f = f'"
  shows "F : baf ↦b ↓CF 𝔉 b'a'f'"
proof(intro is_arrI)
  from assms(1,6,7,8) show "F ∈∘ b ↓CF 𝔉⦇Arr⦈"
    by (cs_concl cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros)
  with assms(2) show "b ↓CF 𝔉⦇Domβ¦ˆβ¦‡F⦈ = baf" "b ↓CF 𝔉⦇Codβ¦ˆβ¦‡F⦈ = b'a'f'"
    by (cs_concl cs_simp: cat_comma_cs_simps)+
qed

lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_is_arrI

lemma (in is_functor) cat_cf_obj_comma_is_arrD[dest]:
  assumes "[[a, b', f]∘, [a', b'', f']∘, [g, h]∘]∘ :
    [a, b', f]∘ ↦𝔉 CF↓ b [a', b'', f']∘"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "b' = []∘"
    and "b'' = []∘"
    and "h = []∘"
    and "g : a ↦𝔄 a'"
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
    and "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
    and "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f"
    and "[a, b', f]∘ ∈∘ 𝔉 CF↓ b⦇Obj⦈"
    and "[a', b'', f']∘ ∈∘ 𝔉 CF↓ b⦇Obj⦈"
  by (intro cat_cf_obj_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+

lemma (in is_functor) cat_obj_cf_comma_is_arrD[dest]:
  assumes "[[b', a, f]∘, [b'', a', f']∘, [h, g]∘]∘ :
    [b', a, f]∘ ↦b ↓CF 𝔉 [b'', a', f']∘"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "b' = 0"
    and "b'' = 0"
    and "h = 0"
    and "g : a ↦𝔄 a'"
    and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
    and "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f = f'"
    and "[b', a, f]∘ ∈∘ b ↓CF 𝔉⦇Obj⦈"
    and "[b'', a', f']∘ ∈∘ b ↓CF 𝔉⦇Obj⦈"
  by (intro cat_obj_cf_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+

lemmas [dest] = is_functor.cat_obj_cf_comma_is_arrD

lemma (in is_functor) cat_cf_obj_comma_is_arrE[elim]:
  assumes "F : abf ↦𝔉 CF↓ b a'b'f'" and "b ∈∘ 𝔅⦇Obj⦈"
  obtains a f a' f' g 
    where "F = [[a, 0, f]∘, [a', 0, f']∘, [g, 0]∘]∘"
      and "abf = [a, 0, f]∘"
      and "a'b'f' = [a', 0, f']∘"
      and "g : a ↦𝔄 a'"
      and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
      and "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
      and "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f"
      and "abf ∈∘ 𝔉 CF↓ b⦇Obj⦈"
      and "a'b'f' ∈∘ 𝔉 CF↓ b⦇Obj⦈"
proof-
  note F = is_arrD[OF assms(1)]
  from F(1) obtain abf' a'b'f'' a f a' f' g 
    where F_def: "F = [abf', a'b'f'', [g, 0]∘]∘"
      and abf'_def: "abf' = [a, 0, f]∘"
      and a'b'f''_def: "a'b'f'' = [a', 0, f']∘"
      and g: "g : a ↦𝔄 a'"
      and f: "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 b"
      and f': "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈ ↦𝔅 b"
      and f_def: "f' ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ = f" 
      and abf': "abf' ∈∘ 𝔉 CF↓ b⦇Obj⦈" 
      and a'b'f'': "a'b'f'' ∈∘ 𝔉 CF↓ b⦇Obj⦈"
    by (elim cat_cf_obj_comma_ArrE[OF _ assms(2)])
  from F(2) assms(2) abf'_def a'b'f''_def g f f' f_def have "abf' = abf"
    unfolding F_def 
    by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
  from F(3) assms(2) abf'_def a'b'f''_def g f f' f_def have "a'b'f'' = a'b'f'"
    unfolding F_def 
    by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
  from that F_def abf'_def a'b'f''_def g f f' f_def abf' a'b'f'' show ?thesis
    unfolding β€Ήabf' = abfβ€Ί β€Ήa'b'f'' = a'b'f'β€Ί by auto
qed

lemmas [elim] = is_functor.cat_cf_obj_comma_is_arrE

lemma (in is_functor) cat_obj_cf_comma_is_arrE[elim]:
  assumes "F : baf ↦b ↓CF 𝔉 b'a'f'"
    and "b ∈∘ 𝔅⦇Obj⦈"
  obtains a f a' f' g
    where "F = [[0, a, f]∘, [0, a', f']∘, [0, g]∘]∘"
      and "baf = [0, a, f]∘"
      and "b'a'f' = [0, a', f']∘"
      and "g : a ↦𝔄 a'"
      and "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      and "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
      and "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f = f'"
      and "baf ∈∘ b ↓CF 𝔉⦇Obj⦈"
      and "b'a'f' ∈∘ b ↓CF 𝔉⦇Obj⦈"
proof-
  note F = is_arrD[OF assms(1)]
  from F(1) obtain baf' b'a'f'' a f a' f' g 
    where F_def: "F = [baf', b'a'f'', [0, g]∘]∘"
      and baf'_def: "baf' = [0, a, f]∘"
      and b'a'f''_def: "b'a'f'' = [0, a', f']∘"
      and g: "g : a ↦𝔄 a'"
      and f: "f : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      and f': "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
      and f'_def: "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 f = f'" 
      and baf': "baf' ∈∘ b ↓CF 𝔉⦇Obj⦈" 
      and b'a'f'': "b'a'f'' ∈∘ b ↓CF 𝔉⦇Obj⦈"
    by (elim cat_obj_cf_comma_ArrE[OF _ assms(2)])
  from F(2) assms(2) baf'_def b'a'f''_def g f f' f'_def have "baf' = baf"
    unfolding F_def 
    by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
  from F(3) assms(2) baf'_def b'a'f''_def g f f' f'_def have "b'a'f'' = b'a'f'"
    unfolding F_def 
    by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
  from that F_def baf'_def b'a'f''_def g f f' f'_def baf' b'a'f'' show ?thesis
    unfolding β€Ήbaf' = bafβ€Ί β€Ήb'a'f'' = b'a'f'β€Ί by auto
qed

lemmas [elim] = is_functor.cat_obj_cf_comma_is_arrE


subsubsectionβ€ΉCompositionβ€Ί

lemma cat_cf_obj_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF↓ b⦇Comp⦈)"
  unfolding cat_cf_obj_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)

lemma cat_obj_cf_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (b ↓CF 𝔉⦇Comp⦈)"
  unfolding cat_obj_cf_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cat_cf_obj_comma_Comp_app[cat_comma_cs_simps]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" 
    and "G = [a'b'f', a''b''f'', [g', h']∘]∘"
    and "F = [abf, a'b'f', [g, h]∘]∘"
    and "G : a'b'f' ↦𝔉 CF↓ b a''b''f''" 
    and "F : abf ↦𝔉 CF↓ b a'b'f'"
  shows "G ∘A𝔉 CF↓ b F = [abf, a''b''f'', [g' ∘A𝔄 g, 0]∘]∘"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(4) obtain a f a' f' g
    where G_def: "G = [[a, 0, f]∘, [a', 0, f']∘, [g, 0]∘]∘"
    by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
  from assms(5) obtain a f a' f' g
    where F_def: "F = [[a, 0, f]∘, [a', 0, f']∘, [g, 0]∘]∘"
    by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
  from assms(2)[unfolded G_def] assms(3)[unfolded F_def] have [cat_cs_simps]:
    "h' = 0" "h = 0"
    by simp_all
  have "h' ∘Acat_1 0 0 h = 0" by (cs_concl cs_simp: cat_cs_simps)
  show ?thesis
    by 
      (
        rule cat_comma_Comp_app
          [
            OF 
              is_functor_axioms 
              const 
              assms(2,3) 
              assms(4)[unfolded cat_cf_obj_comma_def] 
              assms(5)[unfolded cat_cf_obj_comma_def],
            folded cat_cf_obj_comma_def,
            unfolded cat_cs_simps
          ]
      )
qed

lemma (in is_functor) cat_obj_cf_comma_Comp_app[cat_comma_cs_simps]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
    and "G = [b'a'f', b''a''f'', [h', g']∘]∘"
    and "F = [baf, b'a'f', [h, g]∘]∘"
    and "G : b'a'f' ↦b ↓CF 𝔉 b''a''f''" 
    and "F : baf ↦b ↓CF 𝔉 b'a'f'"
  shows "G ∘Ab ↓CF 𝔉 F = [baf, b''a''f'', [0, g' ∘A𝔄 g]∘]∘"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_simp: cs_intro: vempty_is_zet cat_cs_intros)
  from assms(4) obtain a f a' f' g
    where G_def: "G = [[0, a, f]∘, [0, a', f']∘, [0, g]∘]∘"
    by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
  from assms(5) obtain a f a' f' g
    where F_def: "F = [[0, a, f]∘, [0, a', f']∘, [0, g]∘]∘"
    by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
  from assms(2)[unfolded G_def] assms(3)[unfolded F_def] have [cat_cs_simps]:
    "h' = 0" "h = 0"
    by simp_all
  have "h' ∘Acat_1 0 0 h = 0" by (cs_concl cs_simp: cat_cs_simps) show ?thesis
    by 
      (
        rule cat_comma_Comp_app
          [
            OF 
              const 
              is_functor_axioms
              assms(2,3) 
              assms(4)[unfolded cat_obj_cf_comma_def] 
              assms(5)[unfolded cat_obj_cf_comma_def],
            folded cat_obj_cf_comma_def,
            unfolded cat_cs_simps
          ]
      )
qed

lemma (in is_functor) cat_cf_obj_comma_Comp_is_arr[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" 
    and "G : a'b'f' ↦𝔉 CF↓ b a''b''f''" 
    and "F : abf ↦𝔉 CF↓ b a'b'f'"
  shows "G ∘A𝔉 CF↓ b F : abf ↦𝔉 CF↓ b a''b''f''"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Comp_is_arr
          [
            OF 
              is_functor_axioms 
              const 
              assms(2)[unfolded cat_cf_obj_comma_def]
              assms(3)[unfolded cat_cf_obj_comma_def],
            folded cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_functor) cat_obj_cf_comma_Comp_is_arr[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" 
    and "G : b'a'f' ↦b ↓CF 𝔉 b''a''f''" 
    and "F : baf ↦b ↓CF 𝔉 b'a'f'"
  shows "G ∘Ab ↓CF 𝔉 F : baf ↦b ↓CF 𝔉 b''a''f''"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Comp_is_arr
          [
            OF 
              const 
              is_functor_axioms 
              assms(2)[unfolded cat_obj_cf_comma_def]
              assms(3)[unfolded cat_obj_cf_comma_def],
            folded cat_obj_cf_comma_def
          ]
      )
qed


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_cf_obj_comma_CId_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF↓ b⦇CId⦈)"
  unfolding cat_cf_obj_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)

lemma cat_obj_cf_comma_CId_vsv[cat_comma_cs_intros]: "vsv (b ↓CF 𝔉⦇CId⦈)"
  unfolding cat_obj_cf_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cat_cf_obj_comma_CId_vdomain[cat_comma_cs_simps]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "π’Ÿβˆ˜ (𝔉 CF↓ b⦇CId⦈) = 𝔉 CF↓ b⦇Obj⦈"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_CId_vdomain[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_functor) cat_obj_cf_comma_CId_vdomain[cat_comma_cs_simps]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "π’Ÿβˆ˜ (b ↓CF 𝔉⦇CId⦈) = b ↓CF 𝔉⦇Obj⦈"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show "π’Ÿβˆ˜ (b ↓CF 𝔉⦇CId⦈) = b ↓CF 𝔉⦇Obj⦈"
    by 
      (
        rule cat_comma_CId_vdomain[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed

lemma (in is_functor) cat_cf_obj_comma_CId_app[cat_comma_cs_simps]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "A = [a, b', f]∘" and "A ∈∘ 𝔉 CF↓ b⦇Obj⦈"
  shows "𝔉 CF↓ b⦇CIdβ¦ˆβ¦‡A⦈ = [A, A, [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 0]∘]∘"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(3,2) have b'_def: "b' = 0"
    by (auto elim: cat_cf_obj_comma_ObjE[OF _ assms(1)])
  have [cat_cs_simps]: "cat_1 0 0⦇CIdβ¦ˆβ¦‡b'⦈ = 0" 
    unfolding cat_1_components b'_def by simp
  show ?thesis
    by 
      ( 
        rule cat_comma_CId_app
          [
            OF 
              is_functor_axioms 
              const
              assms(2,3)[unfolded cat_cf_obj_comma_def],  
            unfolded cat_cf_obj_comma_def[symmetric] cat_cs_simps
          ]
        )
qed

lemma (in is_functor) cat_obj_cf_comma_CId_app[cat_comma_cs_simps]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "A = [b', a, f]∘" and "A ∈∘ b ↓CF 𝔉⦇Obj⦈"
  shows "b ↓CF 𝔉⦇CIdβ¦ˆβ¦‡A⦈ = [A, A, [0, 𝔄⦇CIdβ¦ˆβ¦‡a⦈]∘]∘"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(3,2) have b'_def: "b' = 0"
    by (auto elim: cat_obj_cf_comma_ObjE[OF _ assms(1)])
  have [cat_cs_simps]: "cat_1 0 0⦇CIdβ¦ˆβ¦‡b'⦈ = 0" 
    unfolding cat_1_components b'_def by simp
  show ?thesis
    by 
      ( 
        rule cat_comma_CId_app
          [
            OF 
              const
              is_functor_axioms 
              assms(2,3)[unfolded cat_obj_cf_comma_def],  
            unfolded cat_obj_cf_comma_def[symmetric] cat_cs_simps
          ]
        )
qed


subsubsectionβ€Ή
Comma categories constructed from a functor and an object are categories
β€Ί

lemma (in is_functor) category_cat_cf_obj_comma[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "category Ξ± (𝔉 CF↓ b)"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule category_cat_comma[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemmas [cat_comma_cs_intros] = is_functor.category_cat_cf_obj_comma

lemma (in is_functor) category_cat_obj_cf_comma[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "category Ξ± (b ↓CF 𝔉)"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule category_cat_comma[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed

lemmas [cat_comma_cs_intros] = is_functor.category_cat_obj_cf_comma


subsubsectionβ€ΉTiny comma categories constructed from a functor and an objectβ€Ί

lemma (in is_tm_functor) tiny_category_cat_cf_obj_comma[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "tiny_category Ξ± (𝔉 CF↓ b)"
proof-
  from assms(1) have const: 
    "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmΞ± 𝔅"
    by 
      (
        cs_concl cs_intro: 
          vempty_is_zet cat_small_cs_intros cat_cs_intros
      )
  show ?thesis
    by 
      (
        rule tiny_category_cat_comma[
          OF is_tm_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_tm_functor) tiny_category_cat_obj_cf_comma[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "tiny_category Ξ± (b ↓CF 𝔉)"
proof-
  from assms(1) have const: 
    "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmΞ± 𝔅"
    by 
      (
        cs_concl cs_intro: 
          vempty_is_zet cat_small_cs_intros cat_cs_intros
      )
  show ?thesis
    by 
      (
        rule tiny_category_cat_comma[
          OF const is_tm_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed



subsectionβ€Ή
Projections for comma categories constructed from a functor and an object
β€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί

definition cf_cf_obj_comma_proj :: "V ⇒ V ⇒ V" (‹(_ CF⨅O _)› [1000, 1000] 999)
  where "𝔉 CFβ¨…O b ≑ 𝔉 CFβ¨… (cf_const (cat_1 0 0) (𝔉⦇HomCod⦈) b)"

definition cf_obj_cf_comma_proj :: "V ⇒ V ⇒ V" (‹(_ O⨅CF _)› [1000, 1000] 999)
  where "b Oβ¨…CF 𝔉 ≑ (cf_const (cat_1 0 0) (𝔉⦇HomCod⦈) b) β¨…CF 𝔉"


textβ€ΉAlternative forms of the definitions.β€Ί

lemma (in is_functor) cf_cf_obj_comma_proj_def:
  "𝔉 CFβ¨…O b = 𝔉 CFβ¨… (cf_const (cat_1 0 0) 𝔅 b)" 
  unfolding cf_cf_obj_comma_proj_def cf_HomCod..

lemma (in is_functor) cf_obj_cf_comma_proj_def: 
  "b Oβ¨…CF 𝔉 = (cf_const (cat_1 0 0) 𝔅 b) β¨…CF 𝔉" 
  unfolding cf_obj_cf_comma_proj_def cf_HomCod..


textβ€ΉComponents.β€Ί

lemma (in is_functor) cf_cf_obj_comma_proj_components[cat_comma_cs_simps]: 
  shows "𝔉 CFβ¨…O b⦇HomDom⦈ = 𝔉 CF↓ b"
    and "𝔉 CFβ¨…O b⦇HomCod⦈ = 𝔄"
  unfolding 
    cf_cf_obj_comma_proj_def 
    cf_comma_proj_left_components 
    cat_cf_obj_comma_def[symmetric]
    cat_cs_simps 
  by simp_all

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_components

lemma (in is_functor) cf_obj_cf_comma_proj_components[cat_comma_cs_simps]: 
  shows "b Oβ¨…CF 𝔉⦇HomDom⦈ = b ↓CF 𝔉"
    and "b Oβ¨…CF 𝔉⦇HomCod⦈ = 𝔄"
  unfolding 
    cf_obj_cf_comma_proj_def 
    cf_comma_proj_right_components 
    cat_obj_cf_comma_def[symmetric]
    cat_cs_simps 
  by simp_all

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_components


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_cf_obj_comma_proj_ObjMap_vsv[cat_comma_cs_intros]: 
  "vsv (𝔉 CFβ¨…O b⦇ObjMap⦈)"
  unfolding cf_cf_obj_comma_proj_def
  by (cs_concl cs_intro: cat_comma_cs_intros)

lemma cf_obj_cf_comma_proj_ObjMap_vsv[cat_comma_cs_intros]: 
  "vsv (b Oβ¨…CF 𝔉⦇ObjMap⦈)"
  unfolding cf_obj_cf_comma_proj_def
  by (cs_concl cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]: 
  "π’Ÿβˆ˜ (𝔉 CFβ¨…O b⦇ObjMap⦈) = 𝔉 CF↓ b⦇Obj⦈"
  unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ObjMap_vdomain
  unfolding 
    cf_cf_obj_comma_proj_def[symmetric] 
    cf_comma_proj_left_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain

lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]: 
  "π’Ÿβˆ˜ (b Oβ¨…CF 𝔉⦇ObjMap⦈) = b ↓CF 𝔉⦇Obj⦈"
  unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ObjMap_vdomain
  unfolding 
    cf_obj_cf_comma_proj_def[symmetric] 
    cf_comma_proj_right_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_vdomain

lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a, b', f]∘" and "[a, b', f]∘ ∈∘ 𝔉 CF↓ b⦇Obj⦈"
  shows "𝔉 CFβ¨…O b⦇ObjMapβ¦ˆβ¦‡A⦈ = a"
  by 
    (
      rule cf_comma_proj_left_ObjMap_app[
        OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def], 
        folded cf_cf_obj_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_app

lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [b', a, f]∘" and "[b', a, f]∘ ∈∘ b ↓CF 𝔉⦇Obj⦈"
  shows "b Oβ¨…CF 𝔉⦇ObjMapβ¦ˆβ¦‡A⦈ = a"
  by 
    (
      rule cf_comma_proj_right_ObjMap_app[
        OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def], 
        folded cf_obj_cf_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_app


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_cf_obj_comma_proj_ArrMap_vsv[cat_comma_cs_intros]: 
  "vsv (𝔉 CFβ¨…O b⦇ArrMap⦈)"
  unfolding cf_cf_obj_comma_proj_def
  by (cs_concl cs_intro: cat_comma_cs_intros)

lemma cf_obj_cf_comma_proj_ArrMap_vsv[cat_comma_cs_intros]: 
  "vsv (b Oβ¨…CF 𝔉⦇ArrMap⦈)"
  unfolding cf_obj_cf_comma_proj_def
  by (cs_concl cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]: 
  "π’Ÿβˆ˜ (𝔉 CFβ¨…O b⦇ArrMap⦈) = 𝔉 CF↓ b⦇Arr⦈"
  unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ArrMap_vdomain
  unfolding 
    cf_cf_obj_comma_proj_def[symmetric] 
    cf_comma_proj_left_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain

lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]:
  "π’Ÿβˆ˜ (b Oβ¨…CF 𝔉⦇ArrMap⦈) = b ↓CF 𝔉⦇Arr⦈"
  unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ArrMap_vdomain
  unfolding 
    cf_obj_cf_comma_proj_def[symmetric] 
    cf_comma_proj_right_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_vdomain

lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_app[cat_comma_cs_simps]:
  assumes "A = [abf, a'b'f', [g, h]∘]∘" 
    and "[abf, a'b'f', [g, h]∘]∘ ∈∘ 𝔉 CF↓ b⦇Arr⦈"
  shows "𝔉 CFβ¨…O b⦇ArrMapβ¦ˆβ¦‡A⦈ = g"
  by 
    (
      rule cf_comma_proj_left_ArrMap_app[
        OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def], 
        folded cf_cf_obj_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ArrMap_app

lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_app[cat_comma_cs_simps]:
  assumes "A = [abf, a'b'f', [g, h]∘]∘" 
    and "[abf, a'b'f', [g, h]∘]∘ ∈∘ b ↓CF 𝔉⦇Arr⦈"
  shows "b Oβ¨…CF 𝔉⦇ArrMapβ¦ˆβ¦‡A⦈ = h"
  by 
    (
      rule cf_comma_proj_right_ArrMap_app[
        OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def], 
        folded cf_obj_cf_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_app


subsubsectionβ€ΉProjections for a comma category are functorsβ€Ί

lemma (in is_functor) cf_cf_obj_comma_proj_is_functor:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝔉 CFβ¨…O b : 𝔉 CF↓ b ↦↦CΞ± 𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_left_is_functor[
          OF is_functor_axioms const,
          folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_functor) cf_cf_obj_comma_proj_is_functor'[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "𝔄' = 𝔉 CF↓ b"
  shows "𝔉 CFβ¨…O b : 𝔄' ↦↦CΞ± 𝔄"
  using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_functor)

lemmas [cat_comma_cs_intros] = is_functor.cf_cf_obj_comma_proj_is_functor'

lemma (in is_functor) cf_obj_cf_comma_proj_is_functor:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "b Oβ¨…CF 𝔉 : b ↓CF 𝔉 ↦↦CΞ± 𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_right_is_functor[
          OF const is_functor_axioms,
          folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
          ]
      )
qed

lemma (in is_functor) cf_obj_cf_comma_proj_is_functor'[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "𝔄' = b ↓CF 𝔉"
  shows "b Oβ¨…CF 𝔉 : 𝔄' ↦↦CΞ± 𝔄"
  using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_functor)

lemmas [cat_comma_cs_intros] = is_functor.cf_obj_cf_comma_proj_is_functor'


subsubsectionβ€ΉProjections for a tiny comma categoryβ€Ί

lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "𝔉 CFβ¨…O b : 𝔉 CF↓ b ↦↦C.tmΞ± 𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmΞ± 𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_left_is_tm_functor[
          OF is_tm_functor_axioms const,
          folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "𝔉b = 𝔉 CF↓ b"
  shows "𝔉 CFβ¨…O b : 𝔉b ↦↦C.tmΞ± 𝔄"
  using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_tm_functor)

lemmas [cat_comma_cs_intros] = is_tm_functor.cf_cf_obj_comma_proj_is_tm_functor'

lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "b Oβ¨…CF 𝔉 : b ↓CF 𝔉 ↦↦C.tmΞ± 𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmΞ± 𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_right_is_tm_functor[
          OF const is_tm_functor_axioms,
          folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
          ]
      )
qed

lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
  assumes "b ∈∘ 𝔅⦇Obj⦈" and "𝔄' = b ↓CF 𝔉"
  shows "b Oβ¨…CF 𝔉 : 𝔄' ↦↦C.tmΞ± 𝔄"
  using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_tm_functor)

lemmas [cat_comma_cs_intros] = is_tm_functor.cf_obj_cf_comma_proj_is_tm_functor'



subsectionβ€ΉComma functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_cf_arr_comma :: "V β‡’ V β‡’ V" 
  (β€Ή(_ A↓CF _)β€Ί [1000, 1000] 999)
  where "g A↓CF 𝔉 =
    [
      (Ξ»A∈∘(𝔉⦇HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF 𝔉⦇Obj⦈. [0, A⦇1β„•β¦ˆ, A⦇2β„•β¦ˆ ∘A𝔉⦇HomCod⦈ g]∘),
      (
        Ξ»F∈∘(𝔉⦇HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF 𝔉⦇Arr⦈.
          [
            [0, F⦇0β¦ˆβ¦‡1β„•β¦ˆ, F⦇0β¦ˆβ¦‡2β„•β¦ˆ ∘A𝔉⦇HomCod⦈ g]∘,
            [0, F⦇1β„•β¦ˆβ¦‡1β„•β¦ˆ, F⦇1β„•β¦ˆβ¦‡2β„•β¦ˆ ∘A𝔉⦇HomCod⦈ g]∘,
            F⦇2β„•β¦ˆ
          ]∘
      ),
      (𝔉⦇HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF 𝔉,
      (𝔉⦇HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡g⦈) ↓CF 𝔉
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_cf_arr_comma_components:
  shows "g A↓CF 𝔉⦇ObjMap⦈ =
    (Ξ»A∈∘(𝔉⦇HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF 𝔉⦇Obj⦈. [0, A⦇1β„•β¦ˆ, A⦇2β„•β¦ˆ ∘A𝔉⦇HomCod⦈ g]∘)"
    and "g A↓CF 𝔉⦇ArrMap⦈ =
      (
        Ξ»F∈∘(𝔉⦇HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF 𝔉⦇Arr⦈.
          [
            [0, F⦇0β¦ˆβ¦‡1β„•β¦ˆ, F⦇0β¦ˆβ¦‡2β„•β¦ˆ ∘A𝔉⦇HomCod⦈ g]∘,
            [0, F⦇1β„•β¦ˆβ¦‡1β„•β¦ˆ, F⦇1β„•β¦ˆβ¦‡2β„•β¦ˆ ∘A𝔉⦇HomCod⦈ g]∘,
            F⦇2β„•β¦ˆ
          ]∘
      )"
    and "g A↓CF 𝔉⦇HomDom⦈ = (𝔉⦇HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF 𝔉"
    and "g A↓CF 𝔉⦇HomCod⦈ = (𝔉⦇HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡g⦈) ↓CF 𝔉"
  unfolding cf_cf_arr_comma_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)

context is_functor
begin

lemma cf_cf_arr_comma_components':
  assumes "g : c ↦𝔅 c'"
  shows "g A↓CF 𝔉⦇ObjMap⦈ = (Ξ»A∈∘c' ↓CF 𝔉⦇Obj⦈. [0, A⦇1β„•β¦ˆ, A⦇2β„•β¦ˆ ∘A𝔅 g]∘)"
    and "g A↓CF 𝔉⦇ArrMap⦈ =
      (
        Ξ»F∈∘c' ↓CF 𝔉⦇Arr⦈.
          [
            [0, F⦇0β¦ˆβ¦‡1β„•β¦ˆ, F⦇0β¦ˆβ¦‡2β„•β¦ˆ ∘A𝔅 g]∘,
            [0, F⦇1β„•β¦ˆβ¦‡1β„•β¦ˆ, F⦇1β„•β¦ˆβ¦‡2β„•β¦ˆ ∘A𝔅 g]∘,
            F⦇2β„•β¦ˆ
          ]∘
      )"
    and [cat_comma_cs_simps]: "g A↓CF 𝔉⦇HomDom⦈ = c' ↓CF 𝔉"
    and [cat_comma_cs_simps]: "g A↓CF 𝔉⦇HomCod⦈ = c ↓CF 𝔉"
  using assms
  unfolding cf_cf_arr_comma_components
  by (simp_all add: cat_cs_simps)

end

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_components'(3,4)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda cf_cf_arr_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
  |vsv cf_cf_arr_comma_ObjMap_vsv[cat_comma_cs_intros]|

context is_functor
begin

context 
  fixes g c c'
  assumes g: "g : c ↦𝔅 c'"
begin

mk_VLambda 
  cf_cf_arr_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
  |vdomain cf_cf_arr_comma_ObjMap_vdomain[cat_comma_cs_simps]|

end

end

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_vdomain

lemma (in is_functor) cf_cf_arr_comma_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a', b', f']∘" and "A ∈∘ c' ↓CF 𝔉⦇Obj⦈" and "g : c ↦𝔅 c'"
  shows "g A↓CF 𝔉⦇ObjMapβ¦ˆβ¦‡A⦈ = [a', b', f' ∘A𝔅 g]∘"
proof-
  from assms have b': "b' ∈∘ 𝔄⦇Obj⦈"
    and f: "f' : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'⦈"
    and a'_def: "a' = 0"
    by auto
  from assms(2) show ?thesis
    unfolding cf_cf_arr_comma_components'[OF assms(3)] assms(1)
    by (simp add: nat_omega_simps a'_def)
qed

lemma (in is_functor) cf_cf_arr_comma_ObjMap_vrange: 
  assumes "g : c ↦𝔅 c'"
  shows "β„›βˆ˜ (g A↓CF 𝔉⦇ObjMap⦈) βŠ†βˆ˜ c ↓CF 𝔉⦇Obj⦈"
proof
  (
    rule vsv.vsv_vrange_vsubset, 
    unfold cf_cf_arr_comma_ObjMap_vdomain[OF assms]
  )
  fix A assume "A ∈∘ c' ↓CF 𝔉⦇Obj⦈"
  with assms is_functor_axioms obtain a f 
    where A_def: "A = [[]∘, a, f]∘"
      and a: "a ∈∘ 𝔄⦇Obj⦈"
      and f: "f : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈" 
    by auto
  from assms a f show "g A↓CF 𝔉⦇ObjMapβ¦ˆβ¦‡A⦈ ∈∘ c ↓CF 𝔉⦇Obj⦈"
    by 
      (
        cs_concl
          cs_simp: cat_comma_cs_simps A_def
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )
qed (cs_concl cs_intro: cat_comma_cs_intros)


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda cf_cf_arr_comma_components(2)
  |vsv cf_cf_arr_comma_ArrMap_vsv[cat_comma_cs_intros]|

context is_functor
begin

context 
  fixes g c c'
  assumes g: "g : c ↦𝔅 c'"
begin

mk_VLambda 
  cf_cf_arr_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
  |vdomain cf_cf_arr_comma_ArrMap_vdomain[cat_comma_cs_simps]|

end

end

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_vdomain

lemma (in is_functor) cf_cf_arr_comma_ArrMap_app[cat_comma_cs_simps]:
  assumes "A = [[a, b, f]∘, [a', b', f']∘, [h, k]∘]∘"
    and "[[a, b, f]∘, [a', b', f']∘, [h, k]∘]∘ :
    [a, b, f]∘ ↦c' ↓CF 𝔉 [a', b', f']∘" 
    and "g : c ↦𝔅 c'"
  shows "g A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡A⦈ =
    [[a, b, f ∘A𝔅 g]∘, [a', b', f' ∘A𝔅 g]∘, [h, k]∘]∘"
proof-
  from assms(3) have c': "c' ∈∘ 𝔅⦇Obj⦈" by auto
  from 
    cat_obj_cf_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c'] 
    is_arrD(1)[OF assms(2)] 
  show ?thesis
    unfolding assms(1) cf_cf_arr_comma_components'[OF assms(3)]
    by (simp_all add: nat_omega_simps)
qed


subsubsectionβ€ΉComma functors are functorsβ€Ί

lemma (in is_functor) cf_cf_arr_comma_is_functor:
  assumes "g : c ↦𝔅 c'"
  shows "g A↓CF 𝔉 : c' ↓CF 𝔉 ↦↦CΞ± c ↓CF 𝔉"
proof-
  show ?thesis
  proof(rule is_functorI')
    show "vfsequence (g A↓CF 𝔉)" unfolding cf_cf_arr_comma_def by simp
    from assms show "category Ξ± (c' ↓CF 𝔉)"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    from assms show "category Ξ± (c ↓CF 𝔉)"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    show "vcard (g A↓CF 𝔉) = 4β„•"
      unfolding  cf_cf_arr_comma_def by (simp_all add: nat_omega_simps)
    from assms show "β„›βˆ˜ (g A↓CF 𝔉⦇ObjMap⦈) βŠ†βˆ˜ c ↓CF 𝔉⦇Obj⦈"
      by (intro cf_cf_arr_comma_ObjMap_vrange)
    show "g A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡F⦈ :
      g A↓CF 𝔉⦇ObjMapβ¦ˆβ¦‡A⦈ ↦c ↓CF 𝔉 g A↓CF 𝔉⦇ObjMapβ¦ˆβ¦‡B⦈"
      if "F : A ↦c' ↓CF 𝔉 B" for A B F
    proof-
      from assms that obtain b f b' f' k 
        where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, k]∘]∘"
          and A_def: "A = [0, b, f]∘"
          and B_def: "B = [0, b', f']∘"
          and k: "k : b ↦𝔄 b'"
          and f: "f : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
          and f': "f' : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'⦈"
          and f'_def: "𝔉⦇ArrMapβ¦ˆβ¦‡k⦈ ∘A𝔅 f = f'"
        by auto
      from assms that k f f' show ?thesis
        unfolding F_def A_def B_def
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps f'_def[symmetric]
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed
    show "g A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡G ∘Ac' ↓CF 𝔉 F⦈ =
      g A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡G⦈ ∘Ac ↓CF 𝔉 g A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡F⦈"
      if "G : B ↦c' ↓CF 𝔉 C" and "F : A ↦c' ↓CF 𝔉 B" for B C G A F
    proof-
      from that(2) assms obtain b f b' f' k 
        where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, k]∘]∘"
          and A_def: "A = [0, b, f]∘"
          and B_def: "B = [0, b', f']∘"
          and k: "k : b ↦𝔄 b'"
          and f: "f : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
          and f': "f' : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'⦈"
          and f'_def: "𝔉⦇ArrMapβ¦ˆβ¦‡k⦈ ∘A𝔅 f = f'"
        by auto
      with that(1) assms obtain b'' f'' k' 
        where G_def: "G = [[0, b', f']∘, [0, b'', f'']∘, [0, k']∘]∘"
          and C_def: "C = [0, b'', f'']∘"
          and k': "k' : b' ↦𝔄 b''"
          and f'': "f'' : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b''⦈"
          and f''_def: "𝔉⦇ArrMapβ¦ˆβ¦‡k'⦈ ∘A𝔅 f' = f''"
        by auto (*slow*)
      from assms that k f f' f'' k' show ?thesis
        unfolding F_def G_def A_def B_def C_def 
        by (*slow*)
          (
            cs_concl
              cs_simp:
                cat_cs_simps cat_comma_cs_simps
                f''_def[symmetric] f'_def[symmetric]
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed
    show "g A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡c' ↓CF 𝔉⦇CIdβ¦ˆβ¦‡C⦈⦈ = c ↓CF 𝔉⦇CIdβ¦ˆβ¦‡g A↓CF 𝔉⦇ObjMapβ¦ˆβ¦‡C⦈⦈"
      if "C ∈∘ c' ↓CF 𝔉⦇Obj⦈" for C
    proof-
      from that assms obtain a f 
        where C_def: "C = [0, a, f]∘"
          and a: "a ∈∘ 𝔄⦇Obj⦈" 
          and f: "f : c' ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
        by auto
      from a assms f show
        "g A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡c' ↓CF 𝔉⦇CIdβ¦ˆβ¦‡C⦈⦈ = c ↓CF 𝔉⦇CIdβ¦ˆβ¦‡g A↓CF 𝔉⦇ObjMapβ¦ˆβ¦‡C⦈⦈"
        unfolding C_def 
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed
  qed
    (
      use assms in
        β€Ή
          cs_concl
            cs_simp: cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
        β€Ί
    )+
qed

lemma (in is_functor) cf_cf_arr_comma_is_functor'[cat_comma_cs_intros]:
  assumes "g : c ↦𝔅 c'" and "𝔄' = c' ↓CF 𝔉" and "𝔅' = c ↓CF 𝔉"
  shows "g A↓CF 𝔉 : 𝔄' ↦↦CΞ± 𝔅'"
  using assms(1) unfolding assms(2,3) by (rule cf_cf_arr_comma_is_functor(1))

lemmas [cat_comma_cs_intros] = is_functor.cf_cf_arr_comma_is_functor'

lemma (in is_functor) cf_cf_arr_comma_CId:
  assumes "b ∈∘ 𝔅⦇Obj⦈"
  shows "(𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉 = cf_id (b ↓CF 𝔉)"
proof-

  show ?thesis
  proof(rule cf_eqI)
    from vempty_is_zet assms show "cf_id (b ↓CF 𝔉) : b ↓CF 𝔉 ↦↦CΞ± b ↓CF 𝔉"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    from vempty_is_zet assms show "(𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉 : b ↓CF 𝔉 ↦↦CΞ± b ↓CF 𝔉"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    from assms have ObjMap_dom_lhs: 
      "π’Ÿβˆ˜ ((𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉⦇ObjMap⦈) = b ↓CF 𝔉⦇Obj⦈"
      by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
    from assms have ObjMap_dom_rhs: 
      "π’Ÿβˆ˜ (dghm_id (b ↓CF 𝔉)⦇ObjMap⦈) = b ↓CF 𝔉⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "(𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉⦇ObjMap⦈ = cf_id (b ↓CF 𝔉)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix A assume prems: "A ∈∘ b ↓CF 𝔉⦇Obj⦈"
      with assms obtain a' f' 
        where A_def: "A = [0, a', f']∘"
          and a': "a' ∈∘ 𝔄⦇Obj⦈" 
          and f': "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a'⦈"
        by auto
      from prems assms vempty_is_zet a' f' show 
        "(𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉⦇ObjMapβ¦ˆβ¦‡A⦈ = cf_id (b ↓CF 𝔉)⦇ObjMapβ¦ˆβ¦‡A⦈"
        unfolding A_def
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)+

    from assms have ArrMap_dom_lhs: 
      "π’Ÿβˆ˜ ((𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉⦇ArrMap⦈) = b ↓CF 𝔉⦇Arr⦈"
      by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
    from assms have ArrMap_dom_rhs: 
      "π’Ÿβˆ˜ (dghm_id (b ↓CF 𝔉)⦇ArrMap⦈) = b ↓CF 𝔉⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

    show "(𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉⦇ArrMap⦈ = cf_id (b ↓CF 𝔉)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix F assume prems: "F ∈∘ b ↓CF 𝔉⦇Arr⦈"
      then obtain A B where F: "F : A ↦b ↓CF 𝔉 B" by (auto dest: is_arrI)
      from assms F obtain b' f' b'' f'' h
        where F_def: "F = [[0, b', f']∘, [0, b'', f'']∘, [0, h]∘]∘"
          and A_def: "A = [0, b', f']∘"
          and B_def: "B = [0, b'', f'']∘"
          and h: "h : b' ↦𝔄 b''"
          and f': "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'⦈"
          and f'': "f'' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b''⦈"
          and "𝔉⦇ArrMapβ¦ˆβ¦‡h⦈ ∘A𝔅 f' = f''"
        by auto
      from assms prems F h f' f'' show 
        "(𝔅⦇CIdβ¦ˆβ¦‡b⦈) A↓CF 𝔉⦇ArrMapβ¦ˆβ¦‡F⦈ = cf_id (b ↓CF 𝔉)⦇ArrMapβ¦ˆβ¦‡F⦈"
        unfolding F_def A_def B_def
        by 
          (
            cs_concl
              cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
          )
    qed (cs_concl cs_intro: cat_comma_cs_intros cat_cs_intros)+

  qed simp_all

qed


subsubsectionβ€ΉComma functors and projectionsβ€Ί

lemma (in is_functor) 
  cf_cf_comp_cf_obj_cf_comma_proj_cf_cf_arr_comma[cat_comma_cs_simps]: 
  assumes "f : a ↦𝔅 b"
  shows "a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉 = b Oβ¨…CF 𝔉"
proof-

  show ?thesis
  proof(rule cf_eqI)
    from assms vempty_is_zet show "b Oβ¨…CF 𝔉 : b ↓CF 𝔉 ↦↦CΞ± 𝔄"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    from assms show 
      "a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉 : b ↓CF 𝔉 ↦↦CΞ± 𝔄"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    from assms have ObjMap_dom_lhs:
      "π’Ÿβˆ˜ ((a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉)⦇ObjMap⦈) = b ↓CF 𝔉⦇Obj⦈"
      by 
        ( 
          cs_concl 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    from assms have ObjMap_dom_rhs: "π’Ÿβˆ˜ (b Oβ¨…CF 𝔉⦇ObjMap⦈) = b ↓CF 𝔉⦇Obj⦈"
      by (cs_concl cs_simp: cat_comma_cs_simps)
    show "(a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉)⦇ObjMap⦈ = b Oβ¨…CF 𝔉⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      from assms show "vsv (b Oβ¨…CF 𝔉⦇ObjMap⦈)"
        by (cs_concl cs_intro: cat_comma_cs_intros)
      fix A assume prems: "A ∈∘ b ↓CF 𝔉⦇Obj⦈"
      with assms obtain b' f' 
        where A_def: "A = [0, b', f']∘"
          and b': "b' ∈∘ 𝔄⦇Obj⦈" 
          and f': "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'⦈"
        by auto
      from prems assms b' f' show 
        "(a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉)⦇ObjMapβ¦ˆβ¦‡A⦈ = b Oβ¨…CF 𝔉⦇ObjMapβ¦ˆβ¦‡A⦈"
        unfolding A_def
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed
      (
        use assms vempty_is_zet in
          β€Ήcs_concl cs_intro: cat_cs_intros cat_comma_cs_introsβ€Ί
      )
    from assms have ArrMap_dom_lhs:
      "π’Ÿβˆ˜ ((a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉)⦇ObjMap⦈) = b ↓CF 𝔉⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    from assms vempty_is_zet have ArrMap_dom_rhs:
      "π’Ÿβˆ˜ (b Oβ¨…CF 𝔉⦇ObjMap⦈) = b ↓CF 𝔉⦇Obj⦈"
      by (cs_concl cs_simp: cat_comma_cs_simps)
    from assms vempty_is_zet have ArrMap_dom_lhs:
      "π’Ÿβˆ˜ ((a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉)⦇ArrMap⦈) = b ↓CF 𝔉⦇Arr⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    from assms have ArrMap_dom_rhs:
      "π’Ÿβˆ˜ (b Oβ¨…CF 𝔉⦇ArrMap⦈) = b ↓CF 𝔉⦇Arr⦈"
      by (cs_concl cs_simp: cat_comma_cs_simps)
    show "(a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉)⦇ArrMap⦈ = b Oβ¨…CF 𝔉⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix F assume "F ∈∘ b ↓CF 𝔉⦇Arr⦈"
      then obtain A B where F: "F : A ↦b ↓CF 𝔉 B"
        by (auto dest: is_arrI)
      with assms obtain b' f' b'' f'' h
        where F_def: "F = [[0, b', f']∘, [0, b'', f'']∘, [0, h]∘]∘"
          and A_def: "A = [0, b', f']∘"
          and B_def: "B = [0, b'', f'']∘"
          and h: "h : b' ↦𝔄 b''"
          and f': "f' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b'⦈"
          and f'': "f'' : b ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b''⦈"
          and f''_def: "𝔉⦇ArrMapβ¦ˆβ¦‡h⦈ ∘A𝔅 f' = f''"
        by auto
      from vempty_is_zet h assms f' f'' F show
        "(a Oβ¨…CF 𝔉 ∘CF f A↓CF 𝔉)⦇ArrMapβ¦ˆβ¦‡F⦈ = b Oβ¨…CF 𝔉⦇ArrMapβ¦ˆβ¦‡F⦈"
        unfolding F_def A_def B_def 
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )+
    qed
      (
        use assms vempty_is_zet in
          β€Ήcs_concl cs_intro: cat_cs_intros cat_comma_cs_introsβ€Ί
      )
  qed simp_all

qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Rel

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉRelβ€Ίβ€Ί
theory CZH_ECAT_Rel
  imports 
    CZH_Foundations.CZH_SMC_Rel
    CZH_ECAT_Functor
    CZH_ECAT_Small_Category
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The methodology chosen for the exposition of β€ΉRelβ€Ί as a category is analogous 
to the one used in the previous installment of this work 
for the exposition of β€ΉRelβ€Ί as a semicategory. 
The general references for this section are Chapter I-7 in 
\cite{mac_lane_categories_2010} and nLab 
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/Rel}
}.
β€Ί

named_theorems cat_Rel_cs_simps
named_theorems cat_Rel_cs_intros

lemmas (in arr_Rel) [cat_Rel_cs_simps] = 
  dg_Rel_shared_cs_simps

lemmas [cat_Rel_cs_simps] = 
  dg_Rel_shared_cs_simps
  arr_Rel.arr_Rel_length
  arr_Rel_comp_Rel_id_Rel_left
  arr_Rel_comp_Rel_id_Rel_right
  arr_Rel.arr_Rel_converse_Rel_converse_Rel
  arr_Rel_converse_Rel_eq_iff
  arr_Rel_converse_Rel_comp_Rel
  arr_Rel_comp_Rel_converse_Rel_left_if_v11
  arr_Rel_comp_Rel_converse_Rel_right_if_v11

lemmas [cat_Rel_cs_intros] = 
  dg_Rel_shared_cs_intros
  arr_Rel_comp_Rel
  arr_Rel.arr_Rel_converse_Rel



subsectionβ€Ήβ€ΉRelβ€Ί as a categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_Rel :: "V β‡’ V"
  where "cat_Rel Ξ± =
    [
      Vset Ξ±,
      set {T. arr_Rel Ξ± T},
      (Ξ»T∈∘set {T. arr_Rel Ξ± T}. T⦇ArrDom⦈),
      (Ξ»T∈∘set {T. arr_Rel Ξ± T}. T⦇ArrCod⦈),
      (Ξ»ST∈∘composable_arrs (dg_Rel Ξ±). ST⦇0⦈ ∘Rel ST⦇1β„•β¦ˆ),
      VLambda (Vset Ξ±) id_Rel 
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_Rel_components:
  shows "cat_Rel α⦇Obj⦈ = Vset Ξ±"
    and "cat_Rel α⦇Arr⦈ = set {T. arr_Rel Ξ± T}"
    and "cat_Rel α⦇Dom⦈ = (Ξ»T∈∘set {T. arr_Rel Ξ± T}. T⦇ArrDom⦈)"
    and "cat_Rel α⦇Cod⦈ = (Ξ»T∈∘set {T. arr_Rel Ξ± T}. T⦇ArrCod⦈)"
    and "cat_Rel α⦇Comp⦈ = (Ξ»ST∈∘composable_arrs (dg_Rel Ξ±). ST⦇0⦈ ∘Rel ST⦇1β„•β¦ˆ)"
    and "cat_Rel α⦇CId⦈ = VLambda (Vset Ξ±) id_Rel"
  unfolding cat_Rel_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_cat_Rel: "cat_smc (cat_Rel Ξ±) = smc_Rel Ξ±"
proof(rule vsv_eqI)
  show "vsv (cat_smc (cat_Rel Ξ±))" unfolding cat_smc_def by auto
  show "vsv (smc_Rel Ξ±)" unfolding smc_Rel_def by auto
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_Rel Ξ±)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_Rel Ξ±) = 5β„•"
    unfolding smc_Rel_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_Rel Ξ±)) = π’Ÿβˆ˜ (smc_Rel Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show 
    "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_Rel Ξ±)) ⟹ cat_smc (cat_Rel Ξ±)⦇a⦈ = smc_Rel α⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        unfold cat_smc_def dg_field_simps cat_Rel_def smc_Rel_def
      )
      (auto simp: nat_omega_simps)
qed

lemmas_with [folded cat_smc_cat_Rel, unfolded slicing_simps]: 
  cat_Rel_Obj_iff = smc_Rel_Obj_iff
  and cat_Rel_Arr_iff[cat_Rel_cs_simps] = smc_Rel_Arr_iff
  and cat_Rel_Dom_vsv[cat_Rel_cs_intros] = smc_Rel_Dom_vsv
  and cat_Rel_Dom_vdomain[cat_Rel_cs_simps] = smc_Rel_Dom_vdomain
  and cat_Rel_Dom_app[cat_Rel_cs_simps] = smc_Rel_Dom_app
  and cat_Rel_Dom_vrange = smc_Rel_Dom_vrange
  and cat_Rel_Cod_vsv[cat_Rel_cs_intros] = smc_Rel_Cod_vsv
  and cat_Rel_Cod_vdomain[cat_Rel_cs_simps] = smc_Rel_Cod_vdomain
  and cat_Rel_Cod_app[cat_Rel_cs_simps] = smc_Rel_Cod_app
  and cat_Rel_Cod_vrange = smc_Rel_Cod_vrange
  and cat_Rel_is_arrI[cat_Rel_cs_intros] = smc_Rel_is_arrI
  and cat_Rel_is_arrD = smc_Rel_is_arrD
  and cat_Rel_is_arrE = smc_Rel_is_arrE

lemmas_with [folded cat_smc_cat_Rel, unfolded slicing_simps, unfolded cat_smc_cat_Rel]: 
  cat_Rel_composable_arrs_dg_Rel = smc_Rel_composable_arrs_dg_Rel
  and cat_Rel_Comp = smc_Rel_Comp
  and cat_Rel_Comp_app[cat_Rel_cs_simps] = smc_Rel_Comp_app
  and cat_Rel_Comp_vdomain[simp] = smc_Rel_Comp_vdomain

lemmas [cat_cs_simps] = cat_Rel_is_arrD(2,3)

lemmas [cat_Rel_cs_intros] = cat_Rel_is_arrI

lemmas_with (in 𝒡) [folded cat_smc_cat_Rel, unfolded slicing_simps]: 
  cat_Rel_Hom_vifunion_in_Vset = smc_Rel_Hom_vifunion_in_Vset
  and cat_Rel_incl_Rel_is_arr = smc_Rel_incl_Rel_is_arr
  and cat_Rel_incl_Rel_is_arr'[cat_Rel_cs_intros] = smc_Rel_incl_Rel_is_arr'
  and cat_CAT_Comp_vrange = smc_CAT_Comp_vrange
  and cat_Rel_is_monic_arrI = smc_Rel_is_monic_arrI
  and cat_Rel_is_monic_arrD = smc_Rel_is_monic_arrD
  and cat_Rel_is_monic_arr = smc_Rel_is_monic_arr
  and cat_Rel_is_monic_arr_is_epic_arr = smc_Rel_is_monic_arr_is_epic_arr
  and cat_Rel_is_epic_arr_is_monic_arr = smc_Rel_is_epic_arr_is_monic_arr
  and cat_Rel_is_epic_arrI = smc_Rel_is_epic_arrI
  and cat_Rel_is_epic_arrD = smc_Rel_is_epic_arrD
  and cat_Rel_is_epic_arr = smc_Rel_is_epic_arr
  and cat_Rel_obj_terminal = smc_Rel_obj_terminal
  and cat_Rel_obj_initial = smc_Rel_obj_initial
  and cat_Rel_obj_terminal_obj_initial = smc_Rel_obj_terminal_obj_initial
  and cat_Rel_obj_null = smc_Rel_obj_null
  and cat_Rel_is_zero_arr = smc_Rel_is_zero_arr

lemmas [cat_Rel_cs_intros] = 𝒡.cat_Rel_incl_Rel_is_arr'


subsubsectionβ€ΉIdentityβ€Ί

lemma (in 𝒡) cat_Rel_CId_app[cat_Rel_cs_simps]:
  assumes "T ∈∘ Vset α"
  shows "cat_Rel α⦇CIdβ¦ˆβ¦‡T⦈ = id_Rel T"
  using assms unfolding cat_Rel_components by simp

lemmas [cat_Rel_cs_simps] = 𝒡.cat_Rel_CId_app


subsubsectionβ€Ήβ€ΉRelβ€Ί is a categoryβ€Ί

lemma (in 𝒡) category_cat_Rel: "category Ξ± (cat_Rel Ξ±)"
proof(rule categoryI, unfold cat_smc_cat_Rel)

  interpret Rel: semicategory Ξ± β€Ήcat_smc (cat_Rel Ξ±)β€Ί
    unfolding cat_smc_cat_Rel by (simp add: semicategory_smc_Rel)

  show "vfsequence (cat_Rel Ξ±)" unfolding cat_Rel_def by simp
  show "vcard (cat_Rel Ξ±) = 6β„•"
    unfolding cat_Rel_def by (simp add: nat_omega_simps)
  show "cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈ : A ↦cat_Rel Ξ± A"
    if "A ∈∘ cat_Rel α⦇Obj⦈" for A
    using that 
    unfolding cat_Rel_Obj_iff
    by 
      (
        cs_concl 
          cs_simp: cat_Rel_cs_simps cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI 
      )
  show "cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈ ∘Acat_Rel Ξ± F = F"
    if "F : A ↦cat_Rel Ξ± B" for F A B
  proof-
    from that have "arr_Rel α F" "A ∈∘ Vset α" "B ∈∘ Vset α"
      by (auto elim: cat_Rel_is_arrE simp: cat_Rel_cs_simps)
    with that show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Rel_cs_simps 
            cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
        )
  qed
  
  show "F ∘Acat_Rel Ξ± cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈ = F"
    if "F : B ↦cat_Rel Ξ± C" for F B C
  proof-
    from that have "arr_Rel α F" "B ∈∘ Vset α" "C ∈∘ Vset α"
      by (auto elim: cat_Rel_is_arrE simp: cat_Rel_cs_simps)
    with that show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Rel_cs_simps
            cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
        )
  qed

qed (auto simp: semicategory_smc_Rel cat_Rel_components)

lemma (in 𝒡) category_cat_Rel'[cat_Rel_cs_intros]: 
  assumes "Ξ±' = Ξ±" and "Ξ±'' = Ξ±"
  shows "category Ξ±' (cat_Rel Ξ±'')"
  unfolding assms by (rule category_cat_Rel)

lemmas [cat_Rel_cs_intros] = 𝒡.category_cat_Rel'



subsectionβ€ΉCanonical dagger for β€ΉRelβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_dag_Rel :: "V β‡’ V" (ܠC.Relβ€Ί)
  where "†C.Rel Ξ± = 
    [
      vid_on (cat_Rel α⦇Obj⦈), 
      VLambda (cat_Rel α⦇Arr⦈) converse_Rel, 
      op_cat (cat_Rel Ξ±), 
      cat_Rel Ξ±
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_dag_Rel_components:
  shows "†C.Rel α⦇ObjMap⦈ = vid_on (cat_Rel α⦇Obj⦈)"
    and "†C.Rel α⦇ArrMap⦈ = VLambda (cat_Rel α⦇Arr⦈) converse_Rel"
    and "†C.Rel α⦇HomDom⦈ = op_cat (cat_Rel Ξ±)"
    and "†C.Rel α⦇HomCod⦈ = cat_Rel Ξ±"
  unfolding cf_dag_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cf_smcf_cf_dag_Rel: "cf_smcf (†C.Rel Ξ±) = †SMC.Rel Ξ±"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (cf_smcf (†C.Rel Ξ±)) = 4β„•" 
    unfolding cf_smcf_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (†SMC.Rel Ξ±) = 4β„•"
    unfolding smcf_dag_Rel_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cf_smcf (†C.Rel Ξ±)) = π’Ÿβˆ˜ (†SMC.Rel Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show "A ∈∘ π’Ÿβˆ˜ (cf_smcf (†C.Rel Ξ±)) ⟹ cf_smcf (†C.Rel Ξ±)⦇A⦈ = †SMC.Rel α⦇A⦈"
    for A
    by
      (
        unfold dom_lhs,
        elim_in_numeral,
        unfold dghm_field_simps[symmetric],
        unfold 
          cat_smc_cat_Rel
          slicing_commute[symmetric]
          cf_smcf_components 
          smcf_dag_Rel_components
          cf_dag_Rel_components
          smc_Rel_components
          cat_Rel_components
      )
      simp_all
qed (auto simp: cf_smcf_def smcf_dag_Rel_def) 

lemmas_with [folded cat_smc_cat_Rel cf_smcf_cf_dag_Rel, unfolded slicing_simps]: 
  cf_dag_Rel_ObjMap_vsv[cat_Rel_cs_intros] = smcf_dag_Rel_ObjMap_vsv
  and cf_dag_Rel_ObjMap_vdomain[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_vdomain
  and cf_dag_Rel_ObjMap_app[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_app
  and cf_dag_Rel_ObjMap_vrange[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_vrange
  and cf_dag_Rel_ArrMap_vsv[cat_Rel_cs_intros] = smcf_dag_Rel_ArrMap_vsv
  and cf_dag_Rel_ArrMap_vdomain[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_vdomain
  and cf_dag_Rel_ArrMap_app[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_app
  and cf_dag_Rel_ArrMap_vrange[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_vrange

lemmas_with (in 𝒡) [
  folded cat_smc_cat_Rel cf_smcf_cf_dag_Rel, unfolded slicing_simps
  ]: 
  cf_dag_Rel_app_is_arr[cat_Rel_cs_intros] = smcf_dag_Rel_app_is_arr
  and cf_dag_Rel_ArrMap_smc_Rel_Comp[cat_Rel_cs_simps] = 
    smcf_dag_Rel_ArrMap_smc_Rel_Comp


subsubsectionβ€ΉCanonical dagger is a contravariant isomorphism of β€ΉRelβ€Ίβ€Ί

lemma (in 𝒡) cf_dag_Rel_is_iso_functor: 
  "†C.Rel Ξ± : op_cat (cat_Rel Ξ±) ↦↦C.isoΞ± cat_Rel Ξ±"
proof
  (
    rule is_iso_functorI, 
    unfold 
      cat_smc_cat_Rel 
      cf_smcf_cf_dag_Rel 
      cat_Rel_components 
      cat_op_simps 
      slicing_commute[symmetric]
  )

  interpret is_iso_semifunctor Ξ± β€Ήop_smc (smc_Rel Ξ±)β€Ί β€Ήsmc_Rel Ξ±β€Ί ܠSMC.Rel Ξ±β€Ί
    by (rule smcf_dag_Rel_is_iso_semifunctor)
  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
  
  show "†C.Rel Ξ± : op_cat (cat_Rel Ξ±) ↦↦CΞ± cat_Rel Ξ±"
  proof
    (
      rule is_functorI, 
      unfold 
        cat_smc_cat_Rel 
        cf_smcf_cf_dag_Rel 
        cat_op_simps 
        slicing_commute[symmetric] 
        cf_dag_Rel_components(3,4)
    )
    show "vfsequence (†C.Rel Ξ±)"
      unfolding cf_dag_Rel_def by (simp add: nat_omega_simps)
    show "vcard (†C.Rel Ξ±) = 4β„•" 
      unfolding cf_dag_Rel_def by (simp add: nat_omega_simps)
    show "†C.Rel α⦇ArrMapβ¦ˆβ¦‡cat_Rel α⦇CIdβ¦ˆβ¦‡C⦈⦈ = cat_Rel α⦇CIdβ¦ˆβ¦‡β€ C.Rel α⦇ObjMapβ¦ˆβ¦‡C⦈⦈"
      if "C ∈∘ cat_Rel α⦇Obj⦈" for C
    proof-
      from that have "C ∈∘ Vset α" 
        by (auto elim: cat_Rel_is_arrE simp: cat_Rel_Obj_iff)
      with that show ?thesis
        by 
          (
            cs_concl 
              cs_simp: cat_Rel_cs_simps cs_intro: cat_cs_intros arr_Rel_id_RelI
          )
    qed
  qed (auto simp: cat_cs_intros intro: smc_cs_intros)

  show "†SMC.Rel Ξ± : op_smc (smc_Rel Ξ±) ↦↦SMC.isoΞ± smc_Rel Ξ±"
    by (rule smcf_dag_Rel_is_iso_semifunctor)

qed

lemma (in 𝒡) cf_dag_Rel_is_iso_functor'[cat_cs_intros]: 
  assumes "𝔄' = op_cat (cat_Rel Ξ±)"
    and "𝔅' = cat_Rel Ξ±"
    and "Ξ±' = Ξ±"
  shows "†C.Rel Ξ± : 𝔄' ↦↦C.isoΞ±' 𝔅'"
  unfolding assms by (rule cf_dag_Rel_is_iso_functor)

lemmas [cat_cs_intros] = 𝒡.cf_dag_Rel_is_iso_functor'


subsubsectionβ€ΉFurther properties of the canonical daggerβ€Ί

lemma (in 𝒡) cf_cn_comp_cf_dag_Rel_cf_dag_Rel: 
  "†C.Rel Ξ± CF∘ †C.Rel Ξ± = cf_id (cat_Rel Ξ±)"
proof(rule cf_smcf_eqI)
  interpret category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
  from cf_dag_Rel_is_iso_functor have dag:
    "†C.Rel Ξ± : op_cat (cat_Rel Ξ±) ↦↦CΞ± cat_Rel Ξ±"
    by (simp add: is_iso_functor.axioms(1))
  from cf_cn_comp_is_functorI[OF category_axioms dag dag] show 
    "†C.Rel Ξ± CF∘ †C.Rel Ξ± : cat_Rel Ξ± ↦↦CΞ± cat_Rel Ξ±" .
  show "cf_id (cat_Rel Ξ±) : cat_Rel Ξ± ↦↦CΞ± cat_Rel Ξ±"
    by (auto simp: category.cat_cf_id_is_functor category_axioms)
  show "cf_smcf (†C.Rel Ξ± CF∘ †C.Rel Ξ±) = cf_smcf (smcf_id (cat_Rel Ξ±))"
    unfolding slicing_commute[symmetric] cat_smc_cat_Rel cf_smcf_cf_dag_Rel
    by (simp add: smcf_cn_comp_smcf_dag_Rel_smcf_dag_Rel)
qed simp_all



subsectionβ€ΉIsomorphismβ€Ί

context 𝒡
begin

context
begin

private lemma cat_Rel_is_arr_isomorphism_right_vsubset:
  assumes "S : B ↦cat_Rel Ξ± A"
    and "T : A ↦cat_Rel Ξ± B"
    and "S ∘Acat_Rel Ξ± T = cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈"
    and "T ∘Acat_Rel Ξ± S = cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈"
  shows "S⦇ArrVal⦈ βŠ†βˆ˜ (T⦇ArrVal⦈)¯∘"
proof(rule vsubset_antisym vsubsetI)

  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (simp add: category_cat_Rel)

  interpret S: arr_Rel Ξ± S
    rewrites "S⦇ArrDom⦈ = B" and "S⦇ArrCod⦈ = A"
    using assms(1)
    by (allβ€Ήelim Rel.cat_is_arrEβ€Ί) (simp_all add: cat_Rel_components)
  interpret T: arr_Rel Ξ± T
    rewrites "T⦇ArrDom⦈ = A" and "T⦇ArrCod⦈ = B"
    using assms(2)
    by (allβ€Ήelim Rel.cat_is_arrEβ€Ί) (simp_all add: cat_Rel_components)
  interpret dag: is_iso_functor Ξ± β€Ήop_cat (cat_Rel Ξ±)β€Ί β€Ήcat_Rel Ξ±β€Ί ܠC.Rel Ξ±β€Ί
    by (auto simp: cf_dag_Rel_is_iso_functor)

  from assms(2) have A: "A ∈∘ cat_Rel α⦇Obj⦈" by auto
  from assms(3) have "(S ∘Acat_Rel Ξ± T)⦇ArrVal⦈ = cat_Rel α⦇CIdβ¦ˆβ¦‡Aβ¦ˆβ¦‡ArrVal⦈"
    by simp
  with A have [simp]: "S⦇ArrVal⦈ ∘∘ T⦇ArrVal⦈ = vid_on A"
    unfolding cat_Rel_Comp_app[OF assms(1,2)]
    by (simp add: id_Rel_components comp_Rel_components cat_Rel_components)

  from assms(2) have B: "B ∈∘ cat_Rel α⦇Obj⦈" by auto
  from assms(4) have "(T ∘Acat_Rel Ξ± S)⦇ArrVal⦈ = cat_Rel α⦇CIdβ¦ˆβ¦‡Bβ¦ˆβ¦‡ArrVal⦈"
    by simp
  with B have [simp]: "T⦇ArrVal⦈ ∘∘ S⦇ArrVal⦈ = vid_on B"
    unfolding cat_Rel_Comp_app[OF assms(2,1)]
    by (simp add: id_Rel_components comp_Rel_components cat_Rel_components)

  fix ab assume ab: "ab ∈∘ S⦇ArrVal⦈"
  with S.vbrelation obtain a b where ab_def: "ab = ⟨a, b⟩" and "a ∈∘ B" 
    by (metis S.arr_Rel_ArrVal_vdomain S.ArrVal.vbrelation_vinE vsubsetE)
  then have "⟨a, a⟩ ∈∘ T⦇ArrVal⦈ ∘∘ S⦇ArrVal⦈" by auto
  then obtain c where "⟨a, c⟩ ∈∘ S⦇ArrVal⦈" and ca[intro]: "⟨c, a⟩ ∈∘ T⦇ArrVal⦈" 
    by blast
  have "⟨b, a⟩ ∈∘ T⦇ArrVal⦈"
  proof(rule ccontr)
    assume "⟨b, a⟩ βˆ‰βˆ˜ T⦇ArrVal⦈"
    with ca have "c β‰  b" by clarsimp
    moreover from ab have "⟨c, b⟩ ∈∘ S⦇ArrVal⦈ ∘∘ T⦇ArrVal⦈" 
      unfolding ab_def by blast
    ultimately show False by (simp add: vid_on_iff)
  qed
  then show "ab ∈∘ (T⦇ArrVal⦈)¯∘" unfolding ab_def by clarsimp

qed

private lemma cat_Rel_is_arr_isomorphism_left_vsubset:
  assumes "S : B ↦cat_Rel Ξ± A" 
    and "T : A ↦cat_Rel Ξ± B" 
    and "S ∘Acat_Rel Ξ± T = cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈"
    and "T ∘Acat_Rel Ξ± S = cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈"
  shows "(T⦇ArrVal⦈)¯∘ βŠ†βˆ˜ S⦇ArrVal⦈"
  using assms(2,3,4) cat_Rel_is_arr_isomorphism_right_vsubset[OF assms(2,1)] 
  by auto

private lemma is_arr_isomorphism_dag: 
  assumes "S : B ↦cat_Rel Ξ± A" 
    and "T : A ↦cat_Rel Ξ± B" 
    and "S ∘Acat_Rel Ξ± T = cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈"
    and "T ∘Acat_Rel Ξ± S = cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈"
  shows "S = †C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈"
proof(rule arr_Rel_eqI[of Ξ±])
  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
  interpret dag: is_iso_functor Ξ± β€Ήop_cat (cat_Rel Ξ±)β€Ί β€Ήcat_Rel Ξ±β€Ί ܠC.Rel Ξ±β€Ί
    by (auto simp: cf_dag_Rel_is_iso_functor)
  from assms(1) show S: "arr_Rel Ξ± S" by (fastforce simp: cat_Rel_components(2))
  from cf_dag_Rel_app_is_arr[OF assms(2)] show "arr_Rel Ξ± (†C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈)"
    by (auto elim!: cat_Rel_is_arrE)
  from assms(2) have T: "arr_Rel Ξ± T" by (auto simp: cat_Rel_is_arrD(1))
  from S T assms show "S⦇ArrVal⦈ = †C.Rel α⦇ArrMapβ¦ˆβ¦‡Tβ¦ˆβ¦‡ArrVal⦈"
    unfolding cf_dag_Rel_ArrMap_app[OF T] converse_Rel_components
    by (intro vsubset_antisym) 
      (
        simp_all add: 
          cat_Rel_is_arr_isomorphism_left_vsubset 
          cat_Rel_is_arr_isomorphism_right_vsubset
      )
  from T assms show "S⦇ArrDom⦈ = †C.Rel α⦇ArrMapβ¦ˆβ¦‡Tβ¦ˆβ¦‡ArrDom⦈"
    unfolding cf_dag_Rel_components 
    by (auto simp: cat_cs_simps cat_Rel_cs_simps converse_Rel_components(1))
  from S assms show "S⦇ArrCod⦈ = †C.Rel α⦇ArrMapβ¦ˆβ¦‡Tβ¦ˆβ¦‡ArrCod⦈"
    by 
      (
        cs_concl 
          cs_intro: cat_op_intros cat_cs_intros 
          cs_simp: cat_Rel_cs_simps cat_cs_simps
      )
qed

lemma cat_Rel_is_arr_isomorphismI[intro]:
  assumes "T : A ↦cat_Rel Ξ± B" 
    and "v11 (T⦇ArrVal⦈)"
    and "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A"
    and "β„›βˆ˜ (T⦇ArrVal⦈) = B"
  shows "T : A ↦isocat_Rel Ξ± B"
proof(rule is_arr_isomorphismI[where ?g = ܠC.Rel α⦇ArrMapβ¦ˆβ¦‡Tβ¦ˆβ€Ί])

  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
  interpret v11: v11 β€ΉT⦇ArrValβ¦ˆβ€Ί by (rule assms(2))

  interpret T: arr_Rel Ξ± T
    rewrites [simp]: "T⦇ArrDom⦈ = A" and [simp]: "T⦇ArrCod⦈ = B"
    using assms(1) 
    by (allβ€Ήelim cat_Rel_is_arrEβ€Ί) (simp_all add: cat_Rel_components)
  interpret is_iso_functor Ξ± β€Ήop_cat (cat_Rel Ξ±)β€Ί β€Ήcat_Rel Ξ±β€Ί ܠC.Rel Ξ±β€Ί
    by (simp add: cf_dag_Rel_is_iso_functor)

  show "T : A ↦cat_Rel Ξ± B" by (rule assms(1))

  show "is_inverse (cat_Rel Ξ±) (†C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈) T"
  proof(intro is_inverseI)
    from assms(1) show dag_T: "†C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈ : B ↦cat_Rel Ξ± A"
      by 
        (
          cs_concl 
            cs_simp: cat_op_simps cat_Rel_cs_simps 
            cs_intro: cat_cs_intros
        )
    show T: "T : A ↦cat_Rel Ξ± B" by (rule assms(1))
    from T T.arr_Rel_axioms v11.v11_axioms assms(3) show 
      "†C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈ ∘Acat_Rel Ξ± T = cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Rel_cs_simps  
            cs_intro: cat_cs_intros cat_Rel_cs_intros
        )
    from T T.arr_Rel_axioms v11.v11_axioms assms(4) show 
      "T ∘Acat_Rel Ξ± †C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈ = cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Rel_cs_simps  
            cs_intro: cat_cs_intros cat_Rel_cs_intros
        )
  qed

qed

lemma cat_Rel_is_arr_isomorphismD[dest]:
  assumes "T : A ↦isocat_Rel Ξ± B"
  shows "T : A ↦cat_Rel Ξ± B" 
    and "v11 (T⦇ArrVal⦈)"
    and "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A"
    and "β„›βˆ˜ (T⦇ArrVal⦈) = B"
proof-

  from assms show T: "T : A ↦cat_Rel Ξ± B" 
    by (simp add: is_arr_isomorphism_def)

  interpret T: arr_Rel Ξ± T
    rewrites [simp]: "T⦇ArrDom⦈ = A" and [simp]: "T⦇ArrCod⦈ = B"
    using T
    by (allβ€Ήelim cat_Rel_is_arrEβ€Ί) (simp_all add: cat_Rel_components)
  
  interpret is_iso_functor Ξ± β€Ήop_cat (cat_Rel Ξ±)β€Ί β€Ήcat_Rel Ξ±β€Ί ܠC.Rel Ξ±β€Ί
    by (simp add: cf_dag_Rel_is_iso_functor)

  from is_arr_isomorphismD[OF assms(1)] obtain S where 
    "is_inverse (cat_Rel Ξ±) S T"
    by clarsimp
  from is_inverseD[OF this] obtain A' B' where "S : B' ↦cat_Rel Ξ± A'" 
    and "T : A' ↦cat_Rel Ξ± B'"
    and "S ∘Acat_Rel Ξ± T = cat_Rel α⦇CIdβ¦ˆβ¦‡A'⦈" 
    and "T ∘Acat_Rel Ξ± S = cat_Rel α⦇CIdβ¦ˆβ¦‡B'⦈"
    by auto
  moreover with T have "A' = A" "B' = B" by auto
  ultimately have S: "S : B ↦cat_Rel Ξ± A" 
    and ST: "S ∘Acat_Rel Ξ± T = cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈" 
    and TS: "T ∘Acat_Rel Ξ± S = cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈"
    by auto
  
  from S T ST TS have S_def: "S = †C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈"
    by (rule is_arr_isomorphism_dag)

  interpret S: arr_Rel Ξ± ܠC.Rel α⦇ArrMapβ¦ˆβ¦‡Tβ¦ˆβ€Ί
    rewrites "(†C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈)⦇ArrDom⦈ = B" 
      and "(†C.Rel α⦇ArrMapβ¦ˆβ¦‡T⦈)⦇ArrCod⦈ = A"
    by (fold S_def, insert S, allβ€Ήelim cat_Rel_is_arrEβ€Ί) 
      (simp_all add: cat_Rel_components)

  from T.arr_Rel_axioms S_def have S_T: "S⦇ArrVal⦈ = (T⦇ArrVal⦈)¯∘"
    by (simp add: cf_dag_Rel_ArrMap_app converse_Rel_components(1))

  from S have A: "A ∈∘ cat_Rel α⦇Obj⦈" and B: "B ∈∘ cat_Rel α⦇Obj⦈" by auto

  from B TS A ST have 
    "(T ∘Rel S)⦇ArrVal⦈ = id_Rel B⦇ArrVal⦈"
    "(S ∘Rel T)⦇ArrVal⦈ = id_Rel A⦇ArrVal⦈"
    unfolding cat_Rel_Comp_app[OF S T] cat_Rel_Comp_app[OF T S]
    unfolding cat_Rel_components
    by simp_all

  then have val_ST: "S⦇ArrVal⦈ ∘∘ T⦇ArrVal⦈ = vid_on A" 
    and val_TS: "T⦇ArrVal⦈ ∘∘ S⦇ArrVal⦈ = vid_on B"
    unfolding comp_Rel_components id_Rel_components by simp_all

  show "v11 (T⦇ArrVal⦈)"
  proof(rule v11I)
  
    show "vsv (T⦇ArrVal⦈)"
    proof(rule vsvI)
      fix a b c assume prems: "⟨a, b⟩ ∈∘ T⦇ArrVal⦈" "⟨a, c⟩ ∈∘ T⦇ArrVal⦈"
      from prems(1) S_T have "⟨b, a⟩ ∈∘ S⦇ArrVal⦈" by auto
      with prems(2) val_TS have "⟨b, c⟩ ∈∘ vid_on B" by auto
      then show "b = c" by clarsimp
    qed (auto simp: T.ArrVal.vbrelation_axioms)

    show "vsv ((T⦇ArrVal⦈)¯∘)"
    proof(rule vsvI)
      fix a b c 
      assume prems: "⟨a, b⟩ ∈∘ (T⦇ArrVal⦈)¯∘" "⟨a, c⟩ ∈∘ (T⦇ArrVal⦈)¯∘"
      with S_T have "⟨a, b⟩ ∈∘ S⦇ArrVal⦈" and "⟨a, c⟩ ∈∘ S⦇ArrVal⦈" by auto
      moreover from prems have "⟨b, a⟩ ∈∘ T⦇ArrVal⦈" and "⟨c, a⟩ ∈∘ T⦇ArrVal⦈" 
        by auto
      ultimately have "⟨b, c⟩ ∈∘ vid_on A" using val_ST by auto
      then show "b = c" by clarsimp
    qed auto

  qed

  show "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A"
  proof(intro vsubset_antisym vsubsetI)
    fix a assume "a ∈∘ A"
    with val_ST have "⟨a, a⟩ ∈∘ S⦇ArrVal⦈ ∘∘ T⦇ArrVal⦈" by auto 
    then show "a ∈∘ π’Ÿβˆ˜ (T⦇ArrVal⦈)" by auto
  qed (use T.arr_Rel_ArrVal_vdomain in auto)

  show "β„›βˆ˜ (T⦇ArrVal⦈) = B"
  proof(intro vsubset_antisym vsubsetI)
    fix b assume "b ∈∘ B"
    with val_TS have "⟨b, b⟩ ∈∘ T⦇ArrVal⦈ ∘∘ S⦇ArrVal⦈" by auto
    then show "b ∈∘ β„›βˆ˜ (T⦇ArrVal⦈)" by auto
  qed (use T.arr_Rel_ArrVal_vrange in auto)

qed

end 

end

lemmas [cat_Rel_cs_simps] = 𝒡.cat_Rel_is_arr_isomorphismD(3,4)

lemma (in 𝒡) cat_Rel_is_arr_isomorphism:
  "T : A ↦isocat_Rel Ξ± B ⟷
    T : A ↦cat_Rel Ξ± B ∧
    v11 (T⦇ArrVal⦈) ∧
    π’Ÿβˆ˜ (T⦇ArrVal⦈) = A ∧
    β„›βˆ˜ (T⦇ArrVal⦈) = B"
  by auto



subsectionβ€ΉThe inverse arrowβ€Ί

lemma (in 𝒡) cat_Rel_the_inverse:
  assumes "T : A ↦isocat_Rel Ξ± B"
  shows "TΒ―Ccat_Rel Ξ± = TΒ―Rel"
  unfolding the_inverse_def
proof(rule the_equality)

  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
  from assms have T: "T : A ↦cat_Rel Ξ± B" by auto
  interpret T: arr_Rel Ξ± T
    rewrites "T⦇ArrDom⦈ = A" and "T⦇ArrCod⦈ = B"
    using T by (allβ€Ήelim cat_Rel_is_arrEβ€Ί) (simp_all add: cat_Rel_components)
  
  from assms T T.arr_Rel_axioms cat_Rel_is_arr_isomorphismD(2)[OF assms] 
  show inv_T_T: "is_inverse (cat_Rel Ξ±) (TΒ―Rel) T"
    by (intro is_inverseI[where a=A and b=B])
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Rel_cs_simps
          cs_intro: cat_Rel_cs_intros cat_cs_intros
      )+

  fix S assume prems: "is_inverse (cat_Rel Ξ±) S T"
  show "S = TΒ―Rel"
    by (rule category.cat_is_inverse_eq[OF Rel.category_axioms prems inv_T_T])

qed

lemmas [cat_Rel_cs_simps] = 𝒡.cat_Rel_the_inverse

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Par

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉParβ€Ίβ€Ί
theory CZH_ECAT_Par
  imports 
    CZH_Foundations.CZH_SMC_Par
    CZH_ECAT_Rel
    CZH_ECAT_Subcategory
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The methodology chosen for the exposition of β€ΉParβ€Ί as a category is 
analogous to the one used in the previous installment of this work 
for the exposition of β€ΉParβ€Ί as a semicategory. 
β€Ί

named_theorems cat_Par_cs_simps
named_theorems cat_Par_cs_intros

lemmas (in arr_Rel) [cat_Par_cs_simps] = 
  dg_Rel_shared_cs_simps

lemmas [cat_Par_cs_simps] = 
  dg_Rel_shared_cs_simps
  arr_Par.arr_Par_length
  arr_Par_comp_Par_id_Par_left
  arr_Par_comp_Par_id_Par_right

lemmas [cat_Par_cs_intros] = 
  arr_Par_comp_Par



subsectionβ€Ήβ€ΉParβ€Ί as a categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_Par :: "V β‡’ V"
  where "cat_Par Ξ± =
    [
      Vset Ξ±,
      set {T. arr_Par Ξ± T},
      (Ξ»T∈∘set {T. arr_Par Ξ± T}. T⦇ArrDom⦈),
      (Ξ»T∈∘set {T. arr_Par Ξ± T}. T⦇ArrCod⦈),
      (Ξ»ST∈∘composable_arrs (dg_Par Ξ±). ST⦇0⦈ ∘Rel ST⦇1β„•β¦ˆ),
      VLambda (Vset Ξ±) id_Par 
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_Par_components:
  shows "cat_Par α⦇Obj⦈ = Vset Ξ±"
    and "cat_Par α⦇Arr⦈ = set {T. arr_Par Ξ± T}"
    and "cat_Par α⦇Dom⦈ = (Ξ»T∈∘set {T. arr_Par Ξ± T}. T⦇ArrDom⦈)"
    and "cat_Par α⦇Cod⦈ = (Ξ»T∈∘set {T. arr_Par Ξ± T}. T⦇ArrCod⦈)"
    and "cat_Par α⦇Comp⦈ = (Ξ»ST∈∘composable_arrs (dg_Par Ξ±). ST⦇0⦈ ∘Par ST⦇1β„•β¦ˆ)"
    and "cat_Par α⦇CId⦈ = VLambda (Vset Ξ±) id_Par"
  unfolding cat_Par_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_cat_Par: "cat_smc (cat_Par Ξ±) = smc_Par Ξ±"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_Par Ξ±)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_Par Ξ±) = 5β„•"
    unfolding smc_Par_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_Par Ξ±)) = π’Ÿβˆ˜ (smc_Par Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_Par Ξ±)) ⟹ cat_smc (cat_Par Ξ±)⦇a⦈ = smc_Par α⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral,
        unfold cat_smc_def dg_field_simps cat_Par_def smc_Par_def
      )
      (auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_Par_def)

lemmas_with [folded cat_smc_cat_Par, unfolded slicing_simps]:
  cat_Par_Obj_iff = smc_Par_Obj_iff
  and cat_Par_Arr_iff[cat_Par_cs_simps] = smc_Par_Arr_iff
  and cat_Par_Dom_vsv[cat_Par_cs_intros] = smc_Par_Dom_vsv
  and cat_Par_Dom_vdomain[cat_Par_cs_simps] = smc_Par_Dom_vdomain
  and cat_Par_Dom_vrange = smc_Par_Dom_vrange
  and cat_Par_Dom_app[cat_Par_cs_simps] = smc_Par_Dom_app
  and cat_Par_Cod_vsv[cat_Par_cs_intros] = smc_Par_Cod_vsv
  and cat_Par_Cod_vdomain[cat_Par_cs_simps] = smc_Par_Cod_vdomain
  and cat_Par_Cod_vrange = smc_Par_Cod_vrange
  and cat_Par_Cod_app[cat_Par_cs_simps] = smc_Par_Cod_app
  and cat_Par_is_arrI = smc_Par_is_arrI
  and cat_Par_is_arrD = smc_Par_is_arrD
  and cat_Par_is_arrE = smc_Par_is_arrE

lemmas_with [folded cat_smc_cat_Par, unfolded slicing_simps]: 
  cat_Par_composable_arrs_dg_Par = smc_Par_composable_arrs_dg_Par
  and cat_Par_Comp = smc_Par_Comp
  and cat_Par_Comp_app[cat_Par_cs_simps] = smc_Par_Comp_app
  and cat_Par_Comp_vdomain[cat_Par_cs_simps] = smc_Par_Comp_vdomain

lemmas [cat_cs_simps] = cat_Par_is_arrD(2,3)

lemmas [cat_Par_cs_intros] = cat_Par_is_arrI

lemmas_with (in 𝒡) [folded cat_smc_cat_Par, unfolded slicing_simps]:
  cat_Par_Hom_vifunion_in_Vset = smc_Par_Hom_vifunion_in_Vset
  and cat_Par_incl_Par_is_arr = smc_Par_incl_Par_is_arr
  and cat_Par_incl_Par_is_arr'[cat_Par_cs_intros] = smc_Par_incl_Par_is_arr'
  and cat_Par_Comp_vrange = smc_Par_Comp_vrange
  and cat_Par_is_monic_arrI = smc_Par_is_monic_arrI
  and cat_Par_is_monic_arr = smc_Par_is_monic_arr
  and cat_Par_is_epic_arrI = smc_Par_is_epic_arrI
  and cat_Par_is_epic_arrD = smc_Par_is_epic_arrD
  and cat_Par_is_epic_arr = smc_Par_is_epic_arr
  and cat_Par_obj_terminal = smc_Par_obj_terminal
  and cat_Par_obj_initial = smc_Par_obj_initial
  and cat_Par_obj_terminal_obj_initial = smc_Par_obj_terminal_obj_initial
  and cat_Par_obj_null = smc_Par_obj_null
  and cat_Par_is_zero_arr = smc_Par_is_zero_arr

lemmas [cat_Par_cs_intros] = 𝒡.cat_Par_incl_Par_is_arr'


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_Par_CId_app[cat_Par_cs_simps]:
  assumes "A ∈∘ Vset α"
  shows "cat_Par α⦇CIdβ¦ˆβ¦‡A⦈ = id_Par A"
  using assms unfolding cat_Par_components by simp

lemma id_Par_CId_app_app[cat_cs_simps]:
  assumes "A ∈∘ Vset α" and "a ∈∘ A"
  shows "cat_Par α⦇CIdβ¦ˆβ¦‡Aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈ = a"
  unfolding cat_Par_CId_app[OF assms(1)] id_Rel_ArrVal_app[OF assms(2)] by simp


subsubsectionβ€Ήβ€ΉParβ€Ί is a categoryβ€Ί

lemma (in 𝒡) category_cat_Par: "category Ξ± (cat_Par Ξ±)"
proof(intro categoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par cat_op_simps)

  interpret Par: semicategory Ξ± β€Ήcat_smc (cat_Par Ξ±)β€Ί
    unfolding cat_smc_cat_Par by (simp add: semicategory_smc_Par)

  show "vfsequence (cat_Par Ξ±)" unfolding cat_Par_def by simp
  show "vcard (cat_Par Ξ±) = 6β„•" 
    unfolding cat_Par_def by (simp add: nat_omega_simps)
  show "cat_Par α⦇CIdβ¦ˆβ¦‡A⦈ : A ↦cat_Par Ξ± A" if "A ∈∘ cat_Par α⦇Obj⦈" for A
    using that
    unfolding cat_Par_Obj_iff
    by 
      (
        cs_concl 
          cs_simp: cat_Par_cs_simps cs_intro: cat_Par_cs_intros arr_Par_id_ParI
      )

  show "cat_Par α⦇CIdβ¦ˆβ¦‡B⦈ ∘Acat_Par Ξ± F = F"
    if "F : A ↦cat_Par Ξ± B" for F A B
  proof-
    from that have "arr_Par α F" "B ∈∘ Vset α"
      by (auto elim: cat_Par_is_arrE simp: cat_Par_cs_simps)
    with that 𝒡_axioms show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Par_cs_simps
            cs_intro: cat_Par_cs_intros arr_Par_id_ParI
        )
  qed

  show "F ∘Acat_Par Ξ± cat_Par α⦇CIdβ¦ˆβ¦‡B⦈ = F"
    if "F : B ↦cat_Par Ξ± C" for F B C
  proof-
    from that have "arr_Par α F" "B ∈∘ Vset α"
      by (auto elim: cat_Par_is_arrE simp: cat_Par_cs_simps)
    with that show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Par_cs_simps
            cs_intro: cat_Par_cs_intros arr_Par_id_ParI
        )
  qed

qed (auto simp: semicategory_smc_Par cat_Par_components)


subsubsectionβ€Ήβ€ΉParβ€Ί is a wide replete subcategory of β€ΉRelβ€Ίβ€Ί

lemma (in 𝒡) wide_replete_subcategory_cat_Par_cat_Rel: 
  "cat_Par Ξ± βŠ†C.wrΞ± cat_Rel Ξ±"
proof(intro wide_replete_subcategoryI)
  show wide_subcategory_cat_Par_cat_Rel: "cat_Par Ξ± βŠ†C.wideΞ± cat_Rel Ξ±"
  proof(intro wide_subcategoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par)
    interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
    interpret Par: category Ξ± β€Ήcat_Par Ξ±β€Ί by (rule category_cat_Par)
    interpret wide_subsemicategory Ξ± β€Ήsmc_Par Ξ±β€Ί β€Ήsmc_Rel Ξ±β€Ί
      by (simp add: wide_subsemicategory_smc_Par_smc_Rel)
    show "cat_Par Ξ± βŠ†CΞ± cat_Rel Ξ±"
    proof(intro subcategoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par)
      show "smc_Par Ξ± βŠ†SMCΞ± smc_Rel Ξ±" by (simp add: subsemicategory_axioms)
      fix A assume "A ∈∘ cat_Par α⦇Obj⦈"
      then show "cat_Par α⦇CIdβ¦ˆβ¦‡A⦈ = cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈"
        unfolding cat_Par_components cat_Rel_components by simp
    qed 
      (
        auto simp: 
          subsemicategory_axioms Rel.category_axioms Par.category_axioms
      )
  qed (rule wide_subsemicategory_smc_Par_smc_Rel)
  show "cat_Par Ξ± βŠ†C.repΞ± cat_Rel Ξ±"
  proof(intro replete_subcategoryI)
    interpret wide_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί
      by (rule wide_subcategory_cat_Par_cat_Rel)
    show "cat_Par Ξ± βŠ†CΞ± cat_Rel Ξ±" by (rule subcategory_axioms)    
    fix A B F assume prems: "A ∈∘ cat_Par α⦇Obj⦈" "F : A ↦isocat_Rel Ξ± B"
    note arr_Rel = cat_Rel_is_arr_isomorphismD[OF prems(2)]
    from arr_Rel(2) show "F : A ↦cat_Par Ξ± B"
      by (intro cat_Par_is_arrI arr_Par_arr_RelI cat_Rel_is_arrD[OF arr_Rel(1)])
        auto
  qed
qed



subsectionβ€ΉIsomorphismβ€Ί

lemma (in 𝒡) cat_Par_is_arr_isomorphismI[intro]:
  assumes "T : A ↦cat_Par Ξ± B" 
    and "v11 (T⦇ArrVal⦈)"
    and "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A"
    and "β„›βˆ˜ (T⦇ArrVal⦈) = B"
  shows "T : A ↦isocat_Par Ξ± B"
proof-
  note [cat_cs_intros] = cat_Rel_is_arr_isomorphismI
  from wide_replete_subcategory_cat_Par_cat_Rel assms have 
    "T : A ↦isocat_Rel Ξ± B"
    by (cs_concl cs_intro: cat_cs_intros cat_sub_cs_intros cat_sub_fw_cs_intros)
  with wide_replete_subcategory_cat_Par_cat_Rel assms show 
    "T : A ↦isocat_Par Ξ± B"
    by (cs_concl cs_simp: cat_sub_bw_cs_simps)
qed

lemma (in 𝒡) cat_Par_is_arr_isomorphismD[dest]:
  assumes "T : A ↦isocat_Par Ξ± B"
  shows "T : A ↦cat_Par Ξ± B"
    and "v11 (T⦇ArrVal⦈)"
    and "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A"
    and "β„›βˆ˜ (T⦇ArrVal⦈) = B"
proof-
  from wide_replete_subcategory_cat_Par_cat_Rel assms have T: 
    "T : A ↦isocat_Rel Ξ± B"
    by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
  show "v11 (T⦇ArrVal⦈)" "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A" "β„›βˆ˜ (T⦇ArrVal⦈) = B"
    by (intro cat_Rel_is_arr_isomorphismD[OF T])+
qed (rule is_arr_isomorphismD(1)[OF assms])

lemma (in 𝒡) cat_Par_is_arr_isomorphism:
  "T : A ↦isocat_Par Ξ± B ⟷
    T : A ↦cat_Par Ξ± B ∧
    v11 (T⦇ArrVal⦈) ∧
    π’Ÿβˆ˜ (T⦇ArrVal⦈) = A ∧
    β„›βˆ˜ (T⦇ArrVal⦈) = B"
  by auto



subsectionβ€ΉThe inverse arrowβ€Ί

abbreviation (input) converse_Par :: "V β‡’ V" ("(_Β―Par)" [1000] 999)
  where "aΒ―Par ≑ aΒ―Rel"

lemma (in 𝒡) cat_Par_the_inverse:
  assumes "T : A ↦isocat_Par Ξ± B"
  shows "TΒ―Ccat_Par Ξ± = TΒ―Par"
proof-
  from wide_replete_subcategory_cat_Par_cat_Rel assms have T:
    "T : A ↦isocat_Rel Ξ± B"
    by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
  from wide_replete_subcategory_cat_Par_cat_Rel assms have [cat_cs_simps]:
    "TΒ―Ccat_Par Ξ± = TΒ―Ccat_Rel Ξ±"
    by (cs_concl cs_full cs_simp: cat_sub_bw_cs_simps cs_intro: cat_sub_cs_intros)
  from T show "TΒ―Ccat_Par Ξ± = TΒ―Rel"
    by (cs_concl cs_simp: cat_Rel_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
qed

lemmas [cat_Par_cs_simps] = 𝒡.cat_Par_the_inverse

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Set

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉSetβ€Ίβ€Ί
theory CZH_ECAT_Set
  imports 
    CZH_Foundations.CZH_SMC_Set
    CZH_ECAT_Par
    CZH_ECAT_Subcategory
    CZH_ECAT_PCategory
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The methodology chosen for the exposition of β€ΉSetβ€Ί as a category is 
analogous to the one used in the previous installment of this work 
for the exposition of β€ΉSetβ€Ί as a semicategory. 
β€Ί

named_theorems cat_Set_cs_simps
named_theorems cat_Set_cs_intros

lemmas (in arr_Set) [cat_Set_cs_simps] = 
  dg_Rel_shared_cs_simps

lemmas [cat_Set_cs_simps] =
  dg_Rel_shared_cs_simps
  arr_Set.arr_Set_ArrVal_vdomain
  arr_Set_comp_Set_id_Set_left
  arr_Set_comp_Set_id_Set_right

lemmas [cat_Set_cs_intros] = 
  dg_Rel_shared_cs_intros
  arr_Set_comp_Set

(*
Certain lemmas are applicable to any of the categories among
Rel, Par, Set. If these lemmas are included in general-purpose
collections like cat_cs_simps/cat_cs_intros, then backtracking
can become slow. The following collections were created to resolve
such issues.
*)
named_theorems cat_rel_par_Set_cs_intros
named_theorems cat_rel_par_Set_cs_simps
named_theorems cat_rel_Par_set_cs_intros
named_theorems cat_rel_Par_set_cs_simps
named_theorems cat_Rel_par_set_cs_intros
named_theorems cat_Rel_par_set_cs_simps



subsectionβ€Ήβ€ΉSetβ€Ί as a categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_Set :: "V β‡’ V"
  where "cat_Set Ξ± =
    [
      Vset Ξ±,
      set {T. arr_Set Ξ± T},
      (Ξ»T∈∘set {T. arr_Set Ξ± T}. T⦇ArrDom⦈),
      (Ξ»T∈∘set {T. arr_Set Ξ± T}. T⦇ArrCod⦈),
      (Ξ»ST∈∘composable_arrs (dg_Set Ξ±). ST⦇0⦈ ∘Rel ST⦇1β„•β¦ˆ),
      VLambda (Vset Ξ±) id_Set 
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_Set_components:
  shows "cat_Set α⦇Obj⦈ = Vset Ξ±"
    and "cat_Set α⦇Arr⦈ = set {T. arr_Set Ξ± T}"
    and "cat_Set α⦇Dom⦈ = (Ξ»T∈∘set {T. arr_Set Ξ± T}. T⦇ArrDom⦈)"
    and "cat_Set α⦇Cod⦈ = (Ξ»T∈∘set {T. arr_Set Ξ± T}. T⦇ArrCod⦈)"
    and "cat_Set α⦇Comp⦈ =
      (Ξ»ST∈∘composable_arrs (dg_Set Ξ±). ST⦇0⦈ ∘Par ST⦇1β„•β¦ˆ)"
    and "cat_Set α⦇CId⦈ = VLambda (Vset Ξ±) id_Set"
  unfolding cat_Set_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_cat_Set: "cat_smc (cat_Set Ξ±) = smc_Set Ξ±"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_Set Ξ±)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_Set Ξ±) = 5β„•"
    unfolding smc_Set_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_Set Ξ±)) = π’Ÿβˆ˜ (smc_Set Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_Set Ξ±)) ⟹ cat_smc (cat_Set Ξ±)⦇a⦈ = smc_Set α⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        unfold cat_smc_def dg_field_simps cat_Set_def smc_Set_def
      )
      (auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_Set_def)

lemmas_with [folded cat_smc_cat_Set, unfolded slicing_simps]:
  cat_Set_Obj_iff = smc_Set_Obj_iff
  and cat_Set_Arr_iff[cat_Set_cs_simps] = smc_Set_Arr_iff
  and cat_Set_Dom_vsv[intro] = smc_Set_Dom_vsv
  and cat_Set_Dom_vdomain[simp] = smc_Set_Dom_vdomain
  and cat_Set_Dom_vrange = smc_Set_Dom_vrange
  and cat_Set_Dom_app = smc_Set_Dom_app
  and cat_Set_Cod_vsv[intro] = smc_Set_Cod_vsv
  and cat_Set_Cod_vdomain[simp] = smc_Set_Cod_vdomain
  and cat_Set_Cod_vrange = smc_Set_Cod_vrange
  and cat_Set_Cod_app[cat_Set_cs_simps] = smc_Set_Cod_app
  and cat_Set_is_arrI = smc_Set_is_arrI
  and cat_Set_is_arrD = smc_Set_is_arrD
  and cat_Set_is_arrE = smc_Set_is_arrE
  and cat_Set_ArrVal_vdomain[cat_cs_simps] = smc_Set_ArrVal_vdomain
  and cat_Set_ArrVal_app_vrange[cat_Set_cs_intros] = smc_Set_ArrVal_app_vrange

lemmas [cat_cs_simps] = cat_Set_is_arrD(2,3)

lemmas [cat_Set_cs_intros] = 
  cat_Set_is_arrI

lemmas_with [folded cat_smc_cat_Set, unfolded slicing_simps]: 
  cat_Set_composable_arrs_dg_Set = smc_Set_composable_arrs_dg_Set
  and cat_Set_Comp = smc_Set_Comp
  and cat_Set_Comp_app[cat_Set_cs_simps] = smc_Set_Comp_app
  and cat_Set_Comp_vdomain[cat_Set_cs_simps] = smc_Set_Comp_vdomain

lemmas_with (in 𝒡) [folded cat_smc_cat_Set, unfolded slicing_simps]:
  cat_Set_Hom_vifunion_in_Vset = smc_Set_Hom_vifunion_in_Vset
  and cat_Set_incl_Set_is_arr = smc_Set_incl_Set_is_arr
  and cat_Set_incl_Set_is_arr'[cat_Set_cs_intros] = smc_Set_incl_Set_is_arr'
  and cat_Set_Comp_ArrVal = smc_Set_Comp_ArrVal
  and cat_Set_Comp_vrange = smc_Set_Comp_vrange
  and cat_Set_is_monic_arrI = smc_Set_is_monic_arrI
  and cat_Set_is_monic_arr = smc_Set_is_monic_arr
  and cat_Set_is_epic_arrI = smc_Set_is_epic_arrI
  and cat_Set_is_epic_arrD = smc_Set_is_epic_arrD
  and cat_Set_is_epic_arr = smc_Set_is_epic_arr
  and cat_Set_obj_terminal = smc_Set_obj_terminal
  and cat_Set_obj_initial = smc_Set_obj_initial
  and cat_Set_obj_null = smc_Set_obj_null
  and cat_Set_is_zero_arr = smc_Set_is_zero_arr

lemmas [cat_Set_cs_intros] = 𝒡.cat_Set_incl_Set_is_arr'

lemmas [cat_cs_simps] = 
  𝒡.cat_Set_Comp_ArrVal


subsubsectionβ€ΉIdentityβ€Ί

lemma cat_Set_CId_app[cat_Set_cs_simps]:
  assumes "A ∈∘ Vset α"
  shows "cat_Set α⦇CIdβ¦ˆβ¦‡A⦈ = id_Set A"
  using assms unfolding cat_Set_components by simp

lemma id_Par_CId_app_app[cat_cs_simps]:
  assumes "A ∈∘ Vset α" and "a ∈∘ A"
  shows "cat_Set α⦇CIdβ¦ˆβ¦‡Aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈ = a"
  unfolding cat_Set_CId_app[OF assms(1)] id_Rel_ArrVal_app[OF assms(2)] by simp


subsubsectionβ€Ήβ€ΉSetβ€Ί is a categoryβ€Ί

lemma (in 𝒡) category_cat_Set: "category Ξ± (cat_Set Ξ±)"
proof(rule categoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)

  interpret Set: semicategory Ξ± β€Ήcat_smc (cat_Set Ξ±)β€Ί
    unfolding cat_smc_cat_Set by (simp add: semicategory_smc_Set)

  show "vfsequence (cat_Set Ξ±)" unfolding cat_Set_def by simp
  show "vcard (cat_Set Ξ±) = 6β„•"
    unfolding cat_Set_def by (simp add: nat_omega_simps)
  show "semicategory Ξ± (smc_Set Ξ±)" by (simp add: semicategory_smc_Set)
  show "cat_Set α⦇CIdβ¦ˆβ¦‡A⦈ : A ↦cat_Set Ξ± A"
    if "A ∈∘ cat_Set α⦇Obj⦈" for A
    using that
    unfolding cat_Set_Obj_iff
    by 
      (
        cs_concl 
          cs_simp: cat_Set_cs_simps cs_intro: cat_Set_cs_intros arr_Set_id_SetI
      )

  show "cat_Set α⦇CIdβ¦ˆβ¦‡B⦈ ∘Acat_Set Ξ± F = F" 
    if "F : A ↦cat_Set Ξ± B" for F A B
  proof-
    from that have "arr_Set α F" "B ∈∘ Vset α" by (auto elim: cat_Set_is_arrE)
    with that show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Set_cs_simps
            cs_intro: cat_Set_cs_intros arr_Set_id_SetI
        )
  qed

  show "F ∘Acat_Set Ξ± cat_Set α⦇CIdβ¦ˆβ¦‡B⦈ = F"
    if "F : B ↦cat_Set Ξ± C" for F B C
  proof-
    from that have "arr_Set α F" "B ∈∘ Vset α" by (auto elim: cat_Set_is_arrE)
    with that show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_Set_cs_simps
            cs_intro: cat_Set_cs_intros arr_Set_id_SetI
        )
  qed

qed (auto simp: cat_Set_components)

lemma (in 𝒡) category_cat_Set':
  assumes "Ξ² = Ξ±"
  shows "category Ξ² (cat_Set Ξ±)"
  unfolding assms by (rule category_cat_Set)

lemmas [cat_cs_intros] = 𝒡.category_cat_Set'


subsubsectionβ€Ήβ€ΉSetβ€Ί is a wide replete subcategory of β€ΉParβ€Ίβ€Ί

lemma (in 𝒡) wide_replete_subcategory_cat_Set_cat_Par: 
  "cat_Set Ξ± βŠ†C.wrΞ± cat_Par Ξ±"
proof(intro wide_replete_subcategoryI)
  show wide_subcategory_cat_Set_cat_Par: "cat_Set Ξ± βŠ†C.wideΞ± cat_Par Ξ±"
  proof(intro wide_subcategoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)
    interpret Par: category Ξ± β€Ήcat_Par Ξ±β€Ί by (rule category_cat_Par)
    interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)
    interpret wide_subsemicategory Ξ± β€Ήsmc_Set Ξ±β€Ί β€Ήsmc_Par Ξ±β€Ί
      by (simp add: wide_subsemicategory_smc_Set_smc_Par)
    show "cat_Set Ξ± βŠ†CΞ± cat_Par Ξ±"
    proof(intro subcategoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)
      show "smc_Set Ξ± βŠ†SMCΞ± smc_Par Ξ±" by (simp add: subsemicategory_axioms)
      fix A assume "A ∈∘ cat_Set α⦇Obj⦈"
      then show "cat_Set α⦇CIdβ¦ˆβ¦‡A⦈ = cat_Par α⦇CIdβ¦ˆβ¦‡A⦈"
        unfolding cat_Set_components cat_Par_components by simp
    qed 
      (
        auto simp: 
          subsemicategory_axioms Par.category_axioms Set.category_axioms
      )
  qed (rule wide_subsemicategory_smc_Set_smc_Par)
  show "cat_Set Ξ± βŠ†C.repΞ± cat_Par Ξ±"
  proof(intro replete_subcategoryI)
    interpret wide_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί
      by (rule wide_subcategory_cat_Set_cat_Par)
    show "cat_Set Ξ± βŠ†CΞ± cat_Par Ξ±" by (rule subcategory_axioms)    
    fix A B F assume "F : A ↦isocat_Par Ξ± B"
    note arr_Par = cat_Par_is_arr_isomorphismD[OF this]
    from arr_Par show "F : A ↦cat_Set Ξ± B"
      by (intro cat_Set_is_arrI arr_Set_arr_ParI cat_Par_is_arrD[OF arr_Par(1)])
        (auto simp: cat_Par_is_arrD(2))
  qed
qed


subsubsectionβ€Ήβ€ΉSetβ€Ί is a subcategory of β€ΉSetβ€Ίβ€Ί

lemma (in 𝒡) subcategory_cat_Set_cat_Set:(*TODO: generalize*)
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "cat_Set Ξ± βŠ†CΞ² cat_Set Ξ²"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show ?thesis  
  proof(intro subcategoryI')
    show "category Ξ² (cat_Set Ξ±)"
      by (rule category.cat_category_if_ge_Limit, insert assms(2))
        (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)+
    show "A ∈∘ cat_Set β⦇Obj⦈" if "A ∈∘ cat_Set α⦇Obj⦈" for A 
      using that 
      unfolding cat_Set_components(1)
      by (meson assms(2) Vset_in_mono Ξ².Axiom_of_Extensionality(3))
    show is_arr_if_is_arr: 
      "F : A ↦cat_Set Ξ² B" if "F : A ↦cat_Set Ξ± B" for A B F
    proof-
      note f = cat_Set_is_arrD[OF that]
      interpret f: arr_Set Ξ± F by (rule f(1))
      show ?thesis
      proof(intro cat_Set_is_arrI arr_SetI)
        show "β„›βˆ˜ (F⦇ArrVal⦈) βŠ†βˆ˜ F⦇ArrCod⦈"  
           by (auto simp: f.arr_Set_ArrVal_vrange)
        show "F⦇ArrDom⦈ ∈∘ Vset Ξ²"
          by (auto intro!: f.arr_Set_ArrDom_in_Vset Vset_in_mono assms(2))
        show "F⦇ArrCod⦈ ∈∘ Vset Ξ²"
          by (auto intro!: f.arr_Set_ArrCod_in_Vset Vset_in_mono assms(2))
      qed 
        (
          auto simp: 
            f f.arr_Set_ArrVal_vdomain f.vfsequence_axioms f.arr_Set_length
        )
    qed
    show "G ∘Acat_Set α F = G ∘Acat_Set β F"
      if "G : B ↦cat_Set Ξ± C" and "F : A ↦cat_Set Ξ± B" for B C G A F
    proof-
      note g = cat_Set_is_arrD[OF that(1)] and f = cat_Set_is_arrD[OF that(2)]      
      from that have Ξ±_gf_is_arr: "G ∘Acat_Set Ξ± F : A ↦cat_Set Ξ² C"
        by (cs_concl cs_intro: cat_cs_intros is_arr_if_is_arr)
      from that have Ξ²_gf_is_arr: "G ∘Acat_Set Ξ² F : A ↦cat_Set Ξ² C"
        by (cs_concl cs_intro: cat_cs_intros is_arr_if_is_arr)
      note Ξ±_gf = cat_Set_is_arrD[OF Ξ±_gf_is_arr]
        and Ξ²_gf = cat_Set_is_arrD[OF Ξ²_gf_is_arr]
      show ?thesis
      proof(rule arr_Set_eqI)
        show "arr_Set β (G ∘Acat_Set α F)" by (rule α_gf(1))
        then interpret arr_Set_Ξ±_gf: arr_Set Ξ² β€Ή(G ∘Acat_Set Ξ± F)β€Ί by simp
        from Ξ±_gf_is_arr have dom_lhs: "π’Ÿβˆ˜ ((G ∘Acat_Set Ξ± F)⦇ArrVal⦈) = A"
          by (cs_concl cs_simp: cat_cs_simps)
        show "arr_Set β (G ∘Acat_Set β F)" by (rule β_gf(1))
        then interpret arr_Set_Ξ²_gf: arr_Set Ξ² β€Ή(G ∘Acat_Set Ξ² F)β€Ί by simp
        from Ξ²_gf_is_arr have dom_rhs: "π’Ÿβˆ˜ ((G ∘Acat_Set Ξ² F)⦇ArrVal⦈) = A"
          by (cs_concl cs_simp: cat_cs_simps)
        show "(G ∘Acat_Set Ξ± F)⦇ArrVal⦈ = (G ∘Acat_Set Ξ² F)⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume "a ∈∘ A"
          from that this show 
            "(G ∘Acat_Set Ξ± F)⦇ArrValβ¦ˆβ¦‡a⦈ = (G ∘Acat_Set Ξ² F)⦇ArrValβ¦ˆβ¦‡a⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps cs_intro: cat_cs_intros is_arr_if_is_arr
              )
        qed auto
      qed (use Ξ±_gf_is_arr Ξ²_gf_is_arr in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
    qed
  qed 
    (
      auto simp: 
        assms(2) cat_Set_components Vset_trans Vset_in_mono cat_cs_intros
    )
qed



subsectionβ€ΉIsomorphismβ€Ί

lemma cat_Set_is_arr_isomorphismI[intro]:
  ―‹
  See \cite{noauthor_nlab_nodate}\footnote{\url{
  https://ncatlab.org/nlab/show/isomorphism
  }}).
  β€Ί
  assumes "T : A ↦cat_Set Ξ± B" 
    and "v11 (T⦇ArrVal⦈)"
    and "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A"
    and "β„›βˆ˜ (T⦇ArrVal⦈) = B"
  shows "T : A ↦isocat_Set Ξ± B"
proof-
  interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF assms(1)])
  note [cat_cs_intros] = cat_Par_is_arr_isomorphismI
  from wide_replete_subcategory_cat_Set_cat_Par assms have 
    "T : A ↦isocat_Par Ξ± B"
    by (cs_concl cs_intro: cat_cs_intros cat_sub_cs_intros cat_sub_fw_cs_intros)
  with wide_replete_subcategory_cat_Set_cat_Par assms show 
    "T : A ↦isocat_Set Ξ± B"
    by (cs_concl cs_simp: cat_sub_bw_cs_simps)
qed

lemma cat_Set_is_arr_isomorphismD[dest]:
  assumes "T : A ↦isocat_Set Ξ± B"
  shows "T : A ↦cat_Set Ξ± B"
    and "v11 (T⦇ArrVal⦈)"
    and "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A"
    and "β„›βˆ˜ (T⦇ArrVal⦈) = B"
proof-
  from assms have T: "T : A ↦cat_Set Ξ± B" by auto
  interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF T])
  from wide_replete_subcategory_cat_Set_cat_Par assms have T: 
    "T : A ↦isocat_Par Ξ± B"
    by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
  show "v11 (T⦇ArrVal⦈)" "π’Ÿβˆ˜ (T⦇ArrVal⦈) = A" "β„›βˆ˜ (T⦇ArrVal⦈) = B"
    by (intro cat_Par_is_arr_isomorphismD[OF T])+
qed (rule is_arr_isomorphismD(1)[OF assms])

lemma cat_Set_is_arr_isomorphism:
  "T : A ↦isocat_Set Ξ± B ⟷ 
    T : A ↦cat_Set Ξ± B ∧
    v11 (T⦇ArrVal⦈) ∧ 
    π’Ÿβˆ˜ (T⦇ArrVal⦈) = A ∧ 
    β„›βˆ˜ (T⦇ArrVal⦈) = B"
  by auto



subsectionβ€ΉThe inverse arrowβ€Ί

lemma cat_Set_ArrVal_app_is_arr[cat_cs_intros]:
  assumes "f : a ↦𝔄 b" 
    and "category Ξ± 𝔄" (*the order of premises is important*)
    and "F : Hom 𝔄 a b ↦cat_Set Ξ± Hom 𝔅 c d"
  shows "F⦇ArrValβ¦ˆβ¦‡f⦈ : c ↦𝔅 d"
proof-
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(2))
  interpret F: arr_Set Ξ± F by (rule cat_Set_is_arrD[OF assms(3)])  
  from assms have "F⦇ArrValβ¦ˆβ¦‡f⦈ ∈∘ Hom 𝔅 c d"
    by (cs_concl cs_intro: cat_cs_intros cat_Set_cs_intros)
  then show ?thesis unfolding in_Hom_iff by simp
qed

abbreviation (input) converse_Set :: "V β‡’ V" ("(_Β―Set)" [1000] 999)
  where "aΒ―Set ≑ aΒ―Rel"

lemma cat_Set_the_inverse[cat_Set_cs_simps]:
  assumes "T : A ↦isocat_Set Ξ± B"
  shows "TΒ―Ccat_Set Ξ± = TΒ―Set"
proof-
  from assms have T: "T : A ↦cat_Set Ξ± B" by auto
  interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF T])
  from wide_replete_subcategory_cat_Set_cat_Par assms have T:
    "T : A ↦isocat_Par Ξ± B"
    by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
  from wide_replete_subcategory_cat_Set_cat_Par assms have [cat_cs_simps]:
    "TΒ―Ccat_Set Ξ± = TΒ―Ccat_Par Ξ±"
    by 
      (
        cs_concl cs_full 
          cs_simp: cat_sub_bw_cs_simps cs_intro: cat_sub_cs_intros
      )
  from T show "TΒ―Ccat_Set Ξ± = TΒ―Rel"
    by (cs_concl cs_simp: cat_Par_cs_simps cat_cs_simps cs_intro: 𝒡_Ξ²)
qed

lemma cat_Set_the_inverse_app[cat_cs_intros]:
  assumes "T : A ↦isocat_Set Ξ± B"
    and "a ∈∘ A"
    and [cat_cs_simps]: "T⦇ArrValβ¦ˆβ¦‡a⦈ = b"
  shows "(TΒ―Ccat_Set Ξ±)⦇ArrValβ¦ˆβ¦‡b⦈ = a"
proof-
  from assms have T: "T : A ↦cat_Set Ξ± B" by auto
  interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF T])
  note T = cat_Set_is_arr_isomorphismD[OF assms(1)]
  interpret T: v11 β€ΉT⦇ArrValβ¦ˆβ€Ί by (rule T(2))
  from T.v11_axioms assms(1,2) show "TΒ―Ccat_Set α⦇ArrValβ¦ˆβ¦‡b⦈ = a"
    by
      (
        cs_concl 
          cs_simp: 
            converse_Rel_components V_cs_simps cat_Set_cs_simps cat_cs_simps 
          cs_intro: cat_arrow_cs_intros cat_cs_intros
      )
qed
                                                          
lemma cat_Set_ArrVal_app_the_inverse_is_arr[cat_cs_intros]:
  assumes "f : c ↦𝔅 d" 
    and "category Ξ± 𝔅" (*the order of premises is important*)
    and "F : Hom 𝔄 a b ↦isocat_Set Ξ± Hom 𝔅 c d"
  shows "FΒ―Ccat_Set α⦇ArrValβ¦ˆβ¦‡f⦈ : a ↦𝔄 b"
proof-
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))
  from cat_Set_is_arr_isomorphismD[OF assms(3)] interpret F: arr_Set Ξ± F 
    by (simp add: cat_Set_is_arrD)  
  from assms have "FΒ―Ccat_Set α⦇ArrValβ¦ˆβ¦‡f⦈ ∈∘ Hom 𝔄 a b"
    by (cs_concl cs_intro: cat_cs_intros cat_arrow_cs_intros)
  then show ?thesis unfolding in_Hom_iff by simp
qed

lemma cat_Set_app_the_inverse_app[cat_cs_simps]:
  assumes "F : A ↦isocat_Set Ξ± B" and "b ∈∘ B"
  shows "F⦇ArrValβ¦ˆβ¦‡FΒ―Ccat_Set α⦇ArrValβ¦ˆβ¦‡b⦈⦈ = b"
proof-
  note F = cat_Set_is_arr_isomorphismD[OF assms(1)]
  note F = F cat_Set_is_arrD[OF F(1)]
  interpret F: arr_Set Ξ± F by (rule cat_Set_is_arrD[OF F(1)])  
  from assms have [cat_cs_simps]: 
    "F ∘Acat_Set Ξ± FΒ―Ccat_Set Ξ± = cat_Set α⦇CIdβ¦ˆβ¦‡B⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms have [cat_cs_simps]: 
    "F⦇ArrValβ¦ˆβ¦‡FΒ―Ccat_Set α⦇ArrValβ¦ˆβ¦‡b⦈⦈ = 
      (F ∘Acat_Set Ξ± FΒ―Ccat_Set Ξ±)⦇ArrValβ¦ˆβ¦‡b⦈"
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
      )
  from assms F.arr_Par_ArrCod_in_Vset[unfolded F] show ?thesis
    by (cs_concl cs_simp: cat_cs_simps)
qed

lemma cat_Set_the_inverse_app_app[cat_cs_simps]:
  assumes "F : A ↦isocat_Set Ξ± B" and "a ∈∘ A"
  shows "FΒ―Ccat_Set α⦇ArrValβ¦ˆβ¦‡F⦇ArrValβ¦ˆβ¦‡a⦈⦈ = a"
proof-
  note F = cat_Set_is_arr_isomorphismD[OF assms(1)]
  note F = F cat_Set_is_arrD[OF F(1)]
  interpret F: arr_Set Ξ± F by (rule cat_Set_is_arrD[OF F(1)])  
  from assms have [cat_cs_simps]:
    "FΒ―Ccat_Set Ξ± ∘Acat_Set Ξ± F = cat_Set α⦇CIdβ¦ˆβ¦‡A⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms have [cat_cs_simps]: 
    "FΒ―Ccat_Set α⦇ArrValβ¦ˆβ¦‡F⦇ArrValβ¦ˆβ¦‡a⦈⦈ =
      (FΒ―Ccat_Set Ξ± ∘Acat_Set Ξ± F)⦇ArrValβ¦ˆβ¦‡a⦈"
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
      )
  from assms F.arr_Par_ArrDom_in_Vset[unfolded F] show ?thesis
    by (cs_concl cs_simp: cat_cs_simps)
qed



subsectionβ€ΉProjection arrows for β€Ήvtimesβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition vfst_arrow :: "V β‡’ V β‡’ V"
  where "vfst_arrow A B = [(Ξ»ab∈∘A Γ—βˆ˜ B. vfst ab), A Γ—βˆ˜ B, A]∘"

definition vsnd_arrow :: "V β‡’ V β‡’ V"
  where "vsnd_arrow A B = [(Ξ»ab∈∘A Γ—βˆ˜ B. vsnd ab), A Γ—βˆ˜ B, B]∘"


textβ€ΉComponents.β€Ί

lemma vfst_arrow_components: 
  shows "vfst_arrow A B⦇ArrVal⦈ = (Ξ»ab∈∘A Γ—βˆ˜ B. vfst ab)"
    and [cat_cs_simps]: "vfst_arrow A B⦇ArrDom⦈ = A Γ—βˆ˜ B"
    and [cat_cs_simps]: "vfst_arrow A B⦇ArrCod⦈ = A"
  unfolding vfst_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)

lemma vsnd_arrow_components: 
  shows "vsnd_arrow A B⦇ArrVal⦈ = (Ξ»ab∈∘A Γ—βˆ˜ B. vsnd ab)"
    and [cat_cs_simps]: "vsnd_arrow A B⦇ArrDom⦈ = A Γ—βˆ˜ B"
    and [cat_cs_simps]: "vsnd_arrow A B⦇ArrCod⦈ = B"
  unfolding vsnd_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda vfst_arrow_components(1)
  |vsv vfst_arrow_ArrVal_vsv[cat_cs_intros]|
  |vdomain vfst_arrow_ArrVal_vdomain[cat_cs_simps]|
  |app vfst_arrow_ArrVal_app'|

mk_VLambda vsnd_arrow_components(1)
  |vsv vsnd_arrow_ArrVal_vsv[cat_cs_intros]|
  |vdomain vsnd_arrow_ArrVal_vdomain[cat_cs_simps]|
  |app vsnd_arrow_ArrVal_app'|

lemma vfst_arrow_ArrVal_app[cat_cs_simps]:
  assumes "ab = ⟨a, b⟩" and "ab ∈∘ A Γ—βˆ˜ B"
  shows "vfst_arrow A B⦇ArrValβ¦ˆβ¦‡ab⦈ = a"
  using assms(2) unfolding assms(1) by (simp add: vfst_arrow_ArrVal_app')

lemma vfst_arrow_vrange: "β„›βˆ˜ (vfst_arrow A B⦇ArrVal⦈) βŠ†βˆ˜ A"
  unfolding vfst_arrow_components
proof(intro vrange_VLambda_vsubset)
  fix ab assume "ab ∈∘ A Γ—βˆ˜ B"
  then obtain a b where ab_def: "ab = ⟨a, b⟩" and a: "a ∈∘ A" by clarsimp
  from a show "vfst ab ∈∘ A" unfolding ab_def by simp
qed

lemma vsnd_arrow_ArrVal_app[cat_cs_simps]:
  assumes "ab = ⟨a, b⟩" and "ab ∈∘ A Γ—βˆ˜ B"
  shows "vsnd_arrow A B⦇ArrValβ¦ˆβ¦‡ab⦈ = b"
  using assms(2) unfolding assms(1) by (simp add: vsnd_arrow_ArrVal_app')

lemma vsnd_arrow_vrange: "β„›βˆ˜ (vsnd_arrow A B⦇ArrVal⦈) βŠ†βˆ˜ B"
  unfolding vsnd_arrow_components
proof(intro vrange_VLambda_vsubset)
  fix ab assume "ab ∈∘ A Γ—βˆ˜ B"
  then obtain a b where ab_def: "ab = ⟨a, b⟩" and b: "b ∈∘ B" by clarsimp
  from b show "vsnd ab ∈∘ B" unfolding ab_def by simp
qed


subsubsectionβ€ΉProjection arrows are arrows in the category β€ΉSetβ€Ίβ€Ί

lemma (in 𝒡) vfst_arrow_is_cat_Set_arr_Vset:
  assumes "A ∈∘ Vset α" and "B ∈∘ Vset α"
  shows "vfst_arrow A B : A Γ—βˆ˜ B ↦cat_Set Ξ± A"
proof(intro cat_Set_is_arrI arr_SetI, unfold cat_cs_simps)
  show "vfsequence (vfst_arrow A B)" unfolding vfst_arrow_def by simp
  show "vcard (vfst_arrow A B) = 3β„•"
    unfolding vfst_arrow_def by (simp add: nat_omega_simps)
  show "β„›βˆ˜ (vfst_arrow A B⦇ArrVal⦈) βŠ†βˆ˜ A" by (rule vfst_arrow_vrange)
qed (use assms in β€Ήcs_concl cs_intro: V_cs_intros cat_cs_introsβ€Ί)+

lemma (in 𝒡) vfst_arrow_is_cat_Set_arr:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" and "B ∈∘ cat_Set α⦇Obj⦈"
  shows "vfst_arrow A B : A Γ—βˆ˜ B ↦cat_Set Ξ± A"
  using assms 
  unfolding cat_Set_components 
  by (rule vfst_arrow_is_cat_Set_arr_Vset)

lemma (in 𝒡) vfst_arrow_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ B"
    and "A' = A"
    and "β„­' = cat_Set Ξ±"
  shows "vfst_arrow A B : AB ↦ℭ' A'"
  using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Set_arr)

lemmas [cat_rel_par_Set_cs_intros] = 𝒡.vfst_arrow_is_cat_Set_arr'

lemma (in 𝒡) vsnd_arrow_is_cat_Set_arr_Vset:
  assumes "A ∈∘ Vset α" and "B ∈∘ Vset α"
  shows "vsnd_arrow A B : A Γ—βˆ˜ B ↦cat_Set Ξ± B"
proof(intro cat_Set_is_arrI arr_SetI , unfold cat_cs_simps)
  show "vfsequence (vsnd_arrow A B)" unfolding vsnd_arrow_def by simp
  show "vcard (vsnd_arrow A B) = 3β„•"
    unfolding vsnd_arrow_def by (simp add: nat_omega_simps)
  show "β„›βˆ˜ (vsnd_arrow A B⦇ArrVal⦈) βŠ†βˆ˜ B" by (rule vsnd_arrow_vrange)
qed (use assms in β€Ήcs_concl cs_intro: V_cs_intros cat_cs_introsβ€Ί)+

lemma (in 𝒡) vsnd_arrow_is_cat_Set_arr:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" and "B ∈∘ cat_Set α⦇Obj⦈"
  shows "vsnd_arrow A B : A Γ—βˆ˜ B ↦cat_Set Ξ± B"
  using assms 
  unfolding cat_Set_components 
  by (rule vsnd_arrow_is_cat_Set_arr_Vset)

lemma (in 𝒡) vsnd_arrow_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ B"
    and "B' = B"
    and "β„­' = cat_Set Ξ±"
  shows "vsnd_arrow A B : AB ↦ℭ' B'"
  using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Set_arr)

lemmas [cat_rel_par_Set_cs_intros] = 𝒡.vsnd_arrow_is_cat_Set_arr'


subsubsectionβ€ΉProjection arrows are arrows in the category β€ΉParβ€Ίβ€Ί

lemma (in 𝒡) vfst_arrow_is_cat_Par_arr:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" and "B ∈∘ cat_Par α⦇Obj⦈"
  shows "vfst_arrow A B : A Γ—βˆ˜ B ↦cat_Par Ξ± A"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  from assms show ?thesis
    unfolding cat_Par_components(1)
    by (intro Set_Par.subcat_is_arrD vfst_arrow_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) vfst_arrow_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ B"
    and "A' = A"
    and "β„­' = cat_Par Ξ±"
  shows "vfst_arrow A B : AB ↦ℭ' A'"
  using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Par_arr)

lemmas [cat_rel_Par_set_cs_intros] = 𝒡.vfst_arrow_is_cat_Par_arr'

lemma (in 𝒡) vsnd_arrow_is_cat_Par_arr:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" and "B ∈∘ cat_Par α⦇Obj⦈"
  shows "vsnd_arrow A B : A Γ—βˆ˜ B ↦cat_Par Ξ± B"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  from assms show ?thesis
    unfolding cat_Par_components(1)
    by (intro Set_Par.subcat_is_arrD vsnd_arrow_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) vsnd_arrow_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ B"
    and "B' = B"
    and "β„­' = cat_Par Ξ±"
  shows "vsnd_arrow A B : AB ↦ℭ' B'"
  using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Par_arr)

lemmas [cat_rel_Par_set_cs_intros] = 𝒡.vsnd_arrow_is_cat_Par_arr'


subsubsectionβ€ΉProjection arrows are arrows in the category β€ΉRelβ€Ίβ€Ί

lemma (in 𝒡) vfst_arrow_is_cat_Rel_arr:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" and "B ∈∘ cat_Rel α⦇Obj⦈"
  shows "vfst_arrow A B : A Γ—βˆ˜ B ↦cat_Rel Ξ± A"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule subcat_trans[
          OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
          ]
      )
  from assms show ?thesis
    unfolding cat_Rel_components(1)
    by (intro Set_Rel.subcat_is_arrD vfst_arrow_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) vfst_arrow_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ B"
    and "A' = A"
    and "β„­' = cat_Rel Ξ±"
  shows "vfst_arrow A B : AB ↦ℭ' A'"
  using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Rel_arr)

lemmas [cat_Rel_par_set_cs_intros] = 𝒡.vfst_arrow_is_cat_Rel_arr'

lemma (in 𝒡) vsnd_arrow_is_cat_Rel_arr:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" and "B ∈∘ cat_Rel α⦇Obj⦈"
  shows "vsnd_arrow A B : A Γ—βˆ˜ B ↦cat_Rel Ξ± B"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule subcat_trans[
          OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
          ]
      )
  from assms show ?thesis
    unfolding cat_Rel_components(1)
    by (intro Set_Rel.subcat_is_arrD vsnd_arrow_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) vsnd_arrow_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ B"
    and "B' = B"
    and "β„­' = cat_Rel Ξ±"
  shows "vsnd_arrow A B : AB ↦ℭ' B'"
  using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Rel_arr)

lemmas [cat_Rel_par_set_cs_intros] = 𝒡.vsnd_arrow_is_cat_Rel_arr'


subsubsectionβ€ΉProjection arrows are isomorphisms in the category β€ΉSetβ€Ίβ€Ί

lemma (in 𝒡) vfst_arrow_is_cat_Set_arr_isomorphism_Vset:
  assumes "A ∈∘ Vset α" and "b ∈∘ Vset α"
  shows "vfst_arrow A (set {b}) : A Γ—βˆ˜ set {b} ↦isocat_Set Ξ± A"
proof
  (
    intro 
      cat_Set_is_arr_isomorphismI 
      arr_SetI 
      vfst_arrow_is_cat_Set_arr_Vset 
      assms,
    unfold cat_cs_simps
  )
  show "v11 (vfst_arrow A (set {b})⦇ArrVal⦈)"
  proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
    fix ab ab' assume prems:
      "ab ∈∘ A Γ—βˆ˜ set {b}"
      "ab' ∈∘ A Γ—βˆ˜ set {b}"
      "vfst_arrow A (set {b})⦇ArrValβ¦ˆβ¦‡ab⦈ = vfst_arrow A (set {b})⦇ArrValβ¦ˆβ¦‡ab'⦈"
    from prems obtain a where ab_def: "ab = ⟨a, b⟩" and a: "a ∈∘ A" 
      by clarsimp
    from prems obtain a' where ab'_def: "ab' = ⟨a', b⟩" and a': "a' ∈∘ A" 
      by clarsimp
    from prems(3) a a' have "a = a'"
      unfolding ab_def ab'_def
      by (cs_prems cs_simp: cat_cs_simps cs_intro: V_cs_intros)
    then show "ab = ab'"  unfolding ab_def ab'_def by simp
  qed (cs_concl cs_intro: cat_cs_intros)
  show "β„›βˆ˜ (vfst_arrow A (set {b})⦇ArrVal⦈) = A"
  proof(intro vsubset_antisym)
    show "A βŠ†βˆ˜ β„›βˆ˜ (vfst_arrow A (set {b})⦇ArrVal⦈)"
    proof(intro vsubsetI)
      fix a assume a: "a ∈∘ A"
      then have a_def: "a = vfst_arrow A (set {b})⦇ArrValβ¦ˆβ¦‡βŸ¨a, b⟩⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
      from a assms show "a ∈∘ β„›βˆ˜ (vfst_arrow A (set {b})⦇ArrVal⦈)"
        by (subst a_def, use nothing in β€Ήintro vsv.vsv_vimageI2β€Ί) 
          (auto simp: cat_cs_simps cat_cs_intros)
    qed
  qed (rule vfst_arrow_vrange)
qed (use assms in auto)

lemma (in 𝒡) vfst_arrow_is_cat_Set_arr_isomorphism:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" and "b ∈∘ cat_Set α⦇Obj⦈"
  shows "vfst_arrow A (set {b}) : A Γ—βˆ˜ set {b} ↦isocat_Set Ξ± A"
  using assms 
  unfolding cat_Set_components 
  by (rule vfst_arrow_is_cat_Set_arr_isomorphism_Vset)

lemma (in 𝒡) vfst_arrow_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "b ∈∘ cat_Set α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ set {b}"
    and "A' = A"
    and "β„­' = cat_Set Ξ±"
  shows "vfst_arrow A (set {b}) : AB ↦isoβ„­' A"
  using assms(1-2) 
  unfolding assms(3-5)
  by (rule vfst_arrow_is_cat_Set_arr_isomorphism)

lemmas [cat_rel_par_Set_cs_intros] = 𝒡.vfst_arrow_is_cat_Set_arr_isomorphism'

lemma (in 𝒡) vsnd_arrow_is_cat_Set_arr_isomorphism_Vset:
  assumes "a ∈∘ Vset α" and "B ∈∘ Vset α"
  shows "vsnd_arrow (set {a}) B : set {a} Γ—βˆ˜ B ↦isocat_Set Ξ± B"
proof
  (
    intro 
      cat_Set_is_arr_isomorphismI 
      arr_SetI 
      vsnd_arrow_is_cat_Set_arr_Vset 
      assms,
    unfold cat_cs_simps
  )
  show "v11 (vsnd_arrow (set {a}) B⦇ArrVal⦈)"
  proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
    fix ab ab' assume prems:
      "ab ∈∘ set {a} Γ—βˆ˜ B"
      "ab' ∈∘ set {a} Γ—βˆ˜ B"
      "vsnd_arrow (set {a}) B⦇ArrValβ¦ˆβ¦‡ab⦈ = vsnd_arrow (set {a}) B⦇ArrValβ¦ˆβ¦‡ab'⦈"
    from prems obtain b where ab_def: "ab = ⟨a, b⟩" and b: "b ∈∘ B" 
      by clarsimp
    from prems obtain b' where ab'_def: "ab' = ⟨a, b'⟩" and b': "b' ∈∘ B" 
      by clarsimp
    from prems(3) b b' have "b = b'"
      unfolding ab_def ab'_def
      by (cs_prems cs_simp: cat_cs_simps cs_intro: V_cs_intros)
    then show "ab = ab'"  unfolding ab_def ab'_def by simp
  qed (cs_concl cs_intro: cat_cs_intros)
  show "β„›βˆ˜ (vsnd_arrow (set {a}) B⦇ArrVal⦈) = B"
  proof(intro vsubset_antisym)
    show "B βŠ†βˆ˜ β„›βˆ˜ (vsnd_arrow (set {a}) B⦇ArrVal⦈)"
    proof(intro vsubsetI)
      fix b assume b: "b ∈∘ B"
      then have b_def: "b = vsnd_arrow (set {a}) B⦇ArrValβ¦ˆβ¦‡βŸ¨a, b⟩⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
      from b assms show "b ∈∘ β„›βˆ˜ (vsnd_arrow (set {a}) B⦇ArrVal⦈)"
        by (subst b_def, use nothing in β€Ήintro vsv.vsv_vimageI2β€Ί) 
          (auto simp: cat_cs_simps cat_cs_intros)
    qed
  qed (rule vsnd_arrow_vrange)
qed (use assms in auto)

lemma (in 𝒡) vsnd_arrow_is_cat_Set_arr_isomorphism:
  assumes "a ∈∘ cat_Set α⦇Obj⦈" and "B ∈∘ cat_Set α⦇Obj⦈"
  shows "vsnd_arrow (set {a}) B : set {a} Γ—βˆ˜ B ↦isocat_Set Ξ± B"
  using assms 
  unfolding cat_Set_components 
  by (rule vsnd_arrow_is_cat_Set_arr_isomorphism_Vset)

lemma (in 𝒡) vsnd_arrow_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
  assumes "a ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈"
    and "AB = set {a} Γ—βˆ˜ B"
    and "A' = A"
    and "β„­' = cat_Set Ξ±"
  shows "vsnd_arrow (set {a}) B : AB ↦isoβ„­' B"
  using assms(1-2) 
  unfolding assms(3-5)
  by (rule vsnd_arrow_is_cat_Set_arr_isomorphism)

lemmas [cat_rel_par_Set_cs_intros] = 𝒡.vsnd_arrow_is_cat_Set_arr_isomorphism'


subsubsectionβ€ΉProjection arrows are isomorphisms in the category β€ΉParβ€Ίβ€Ί

lemma (in 𝒡) vfst_arrow_is_cat_Par_arr_isomorphism:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" and "b ∈∘ cat_Par α⦇Obj⦈"
  shows "vfst_arrow A (set {b}) : A Γ—βˆ˜ set {b} ↦isocat_Par Ξ± A"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  show "vfst_arrow A (set {b}) : A Γ—βˆ˜ set {b} ↦isocat_Par Ξ± A"
    by 
      (
        rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Par_components]
              ]
          ]
      )
qed

lemma (in 𝒡) vfst_arrow_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "b ∈∘ cat_Par α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ set {b}"
    and "A' = A"
    and "β„­' = cat_Par Ξ±"
  shows "vfst_arrow A (set {b}) : AB ↦isoβ„­' A"
  using assms(1-2) 
  unfolding assms(3-5)
  by (rule vfst_arrow_is_cat_Par_arr_isomorphism)

lemmas [cat_rel_Par_set_cs_intros] = 𝒡.vfst_arrow_is_cat_Par_arr_isomorphism'

lemma (in 𝒡) vsnd_arrow_is_cat_Par_arr_isomorphism:
  assumes "a ∈∘ cat_Par α⦇Obj⦈" and "B ∈∘ cat_Par α⦇Obj⦈"
  shows "vsnd_arrow (set {a}) B : set {a} Γ—βˆ˜ B ↦isocat_Par Ξ± B"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  show "vsnd_arrow (set {a}) B : set {a} Γ—βˆ˜ B ↦isocat_Par Ξ± B"
    by 
      (
        rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Par_components]
              ]
          ]
      )
qed

lemma (in 𝒡) vsnd_arrow_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
  assumes "a ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈"
    and "AB = set {a} Γ—βˆ˜ B"
    and "A' = A"
    and "β„­' = cat_Par Ξ±"
  shows "vsnd_arrow (set {a}) B : AB ↦isoβ„­' B"
  using assms(1-2) 
  unfolding assms(3-5)
  by (rule vsnd_arrow_is_cat_Par_arr_isomorphism)

lemmas [cat_rel_Par_set_cs_intros] = 𝒡.vsnd_arrow_is_cat_Par_arr_isomorphism'


subsubsectionβ€ΉProjection arrows are isomorphisms in the category β€ΉRelβ€Ίβ€Ί

lemma (in 𝒡) vfst_arrow_is_cat_Rel_arr_isomorphism:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" and "b ∈∘ cat_Rel α⦇Obj⦈"
  shows "vfst_arrow A (set {b}) : A Γ—βˆ˜ set {b} ↦isocat_Rel Ξ± A"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule wr_subcat_trans
          [
            OF 
              Set_Par.wide_replete_subcategory_axioms 
              Par_Rel.wide_replete_subcategory_axioms
          ]
      )
  show ?thesis
    by 
      (
        rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Rel_components]
              ]
          ]
      )
qed

lemma (in 𝒡) vfst_arrow_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "b ∈∘ cat_Rel α⦇Obj⦈"
    and "AB = A Γ—βˆ˜ set {b}"
    and "A' = A"
    and "β„­' = cat_Rel Ξ±"
  shows "vfst_arrow A (set {b}) : AB ↦isoβ„­' A"
  using assms(1-2) 
  unfolding assms(3-5)
  by (rule vfst_arrow_is_cat_Rel_arr_isomorphism)

lemmas [cat_Rel_par_set_cs_intros] = 𝒡.vfst_arrow_is_cat_Rel_arr_isomorphism'

lemma (in 𝒡) vsnd_arrow_is_cat_Rel_arr_isomorphism:
  assumes "a ∈∘ cat_Rel α⦇Obj⦈" and "B ∈∘ cat_Rel α⦇Obj⦈"
  shows "vsnd_arrow (set {a}) B : set {a} Γ—βˆ˜ B ↦isocat_Rel Ξ± B"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule wr_subcat_trans
          [
            OF 
              Set_Par.wide_replete_subcategory_axioms 
              Par_Rel.wide_replete_subcategory_axioms
          ]
      )
  show ?thesis
    by 
      (
        rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Rel_components]
              ]
          ]
      )
qed

lemma (in 𝒡) vsnd_arrow_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
  assumes "a ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈"
    and "AB = set {a} Γ—βˆ˜ B"
    and "A' = A"
    and "β„­' = cat_Rel Ξ±"
  shows "vsnd_arrow (set {a}) B : AB ↦isoβ„­' B"
  using assms(1-2) 
  unfolding assms(3-5)
  by (rule vsnd_arrow_is_cat_Rel_arr_isomorphism)

lemmas [cat_Rel_par_set_cs_intros] = 𝒡.vsnd_arrow_is_cat_Rel_arr_isomorphism'



subsectionβ€ΉProjection arrow for β€Ήvproductβ€Ίβ€Ί

definition vprojection_arrow :: "V β‡’ (V β‡’ V) β‡’ V β‡’ V"
  where "vprojection_arrow I A i = [vprojection I A i, (∏∘i∈∘I. A i), A i]∘"


textβ€ΉComponents.β€Ί

lemma vprojection_arrow_components:
  shows "vprojection_arrow I A i⦇ArrVal⦈ = vprojection I A i"
    and "vprojection_arrow I A i⦇ArrDom⦈ = (∏∘i∈∘I. A i)"
    and "vprojection_arrow I A i⦇ArrCod⦈ = A i"
  unfolding vprojection_arrow_def arr_field_simps
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉProjection arrow valueβ€Ί

mk_VLambda vprojection_arrow_components(1)[unfolded vprojection_def]
  |vsv vprojection_arrow_vsv[cat_Set_cs_intros]|
  |vdomain vprojection_arrow_vdomain[cat_Set_cs_simps]|
  |app vprojection_arrow_app[cat_Set_cs_simps]|


subsubsectionβ€ΉProjection arrow is an arrow in the category β€ΉSetβ€Ίβ€Ί

lemma (in 𝒡) arr_Set_vprojection_arrow:
  assumes "i ∈∘ I" and "VLambda I A ∈∘ Vset α"
  shows "arr_Set Ξ± (vprojection_arrow I A i)"
proof(intro arr_SetI)
  show "vfsequence (vprojection_arrow I A i)"
    unfolding vprojection_arrow_def by auto
  show "vcard (vprojection_arrow I A i) = 3β„•"
    unfolding vprojection_arrow_def by (simp add: nat_omega_simps)
  show "vprojection_arrow I A i⦇ArrCod⦈ ∈∘ Vset Ξ±"
    unfolding vprojection_arrow_components
  proof-
    from assms(1) have "i ∈∘ I" by simp
    then have "A i ∈∘ β„›βˆ˜ (VLambda I A)" by auto
    moreover from assms(2) have "β„›βˆ˜ (VLambda I A) ∈∘ Vset Ξ±"
      by (meson vrange_in_VsetI)
    ultimately show "A i ∈∘ Vset α" by auto   
  qed
qed 
  (
    auto 
      simp: vprojection_arrow_components 
      intro!: 
        assms 
        vprojection_vrange_vsubset 
        Limit_vproduct_in_Vset_if_VLambda_in_VsetI
  )

lemma (in 𝒡) vprojection_arrow_is_arr:
  assumes "i ∈∘ I" and "VLambda I A ∈∘ Vset α"
  shows "vprojection_arrow I A i : (∏∘i∈∘I. A i) ↦cat_Set Ξ± A i"
proof(intro cat_Set_is_arrI)
  from assms show "arr_Set Ξ± (vprojection_arrow I A i)"
    by (rule arr_Set_vprojection_arrow)
qed (simp_all add: vprojection_arrow_components)



subsectionβ€ΉProduct arrow value for β€ΉRelβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition prod_2_Rel_ArrVal :: "V β‡’ V β‡’ V"
  where "prod_2_Rel_ArrVal S T =
    set {⟨⟨a, b⟩, ⟨c, d⟩⟩ | a b c d. ⟨a, c⟩ ∈∘ S ∧ ⟨b, d⟩ ∈∘ T}"

lemma small_prod_2_Rel_ArrVal[simp]:
  "small {⟨⟨a, b⟩, ⟨c, d⟩⟩ | a b c d. ⟨a, c⟩ ∈∘ S ∧ ⟨b, d⟩ ∈∘ T}"
  (is β€Ήsmall ?Sβ€Ί)
proof(rule down)
  show "?S βŠ† elts ((π’Ÿβˆ˜ S Γ—βˆ˜ π’Ÿβˆ˜ T) Γ—βˆ˜ (β„›βˆ˜ S Γ—βˆ˜ β„›βˆ˜ T))" by auto
qed


textβ€ΉRules.β€Ί

lemma prod_2_Rel_ArrValI:
  assumes "ab_cd = ⟨⟨a, b⟩, ⟨c, d⟩⟩"
    and "⟨a, c⟩ ∈∘ S"
    and "⟨b, d⟩ ∈∘ T"
  shows "ab_cd ∈∘ prod_2_Rel_ArrVal S T"
  using assms unfolding prod_2_Rel_ArrVal_def by simp

lemma prod_2_Rel_ArrValD[dest]:
  assumes "⟨⟨a, b⟩, ⟨c, d⟩⟩ ∈∘ prod_2_Rel_ArrVal S T"
  shows "⟨a, c⟩ ∈∘ S" and "⟨b, d⟩ ∈∘ T"
  using assms unfolding prod_2_Rel_ArrVal_def by auto

lemma prod_2_Rel_ArrValE[elim]:
  assumes "ab_cd ∈∘ prod_2_Rel_ArrVal S T"
  obtains a b c d where "ab_cd = ⟨⟨a, b⟩, ⟨c, d⟩⟩" 
    and "⟨a, c⟩ ∈∘ S"
    and "⟨b, d⟩ ∈∘ T"
  using assms unfolding prod_2_Rel_ArrVal_def by auto


textβ€ΉElementary propertiesβ€Ί

lemma prod_2_Rel_ArrVal_vsubset_vprod:
  "prod_2_Rel_ArrVal S T βŠ†βˆ˜ ((π’Ÿβˆ˜ S Γ—βˆ˜ π’Ÿβˆ˜ T) Γ—βˆ˜ (β„›βˆ˜ S Γ—βˆ˜ β„›βˆ˜ T))"
  by auto

lemma prod_2_Rel_ArrVal_vbrelation: "vbrelation (prod_2_Rel_ArrVal S T)"
  using prod_2_Rel_ArrVal_vsubset_vprod by auto

lemma prod_2_Rel_ArrVal_vdomain: "π’Ÿβˆ˜ (prod_2_Rel_ArrVal S T) = π’Ÿβˆ˜ S Γ—βˆ˜ π’Ÿβˆ˜ T"
proof(intro vsubset_antisym)
  show "π’Ÿβˆ˜ S Γ—βˆ˜ π’Ÿβˆ˜ T βŠ†βˆ˜ π’Ÿβˆ˜ (prod_2_Rel_ArrVal S T)"
  proof(intro vsubsetI)
    fix ab assume "ab ∈∘ π’Ÿβˆ˜ S Γ—βˆ˜ π’Ÿβˆ˜ T"
    then obtain a b
      where ab_def: "ab = ⟨a, b⟩" 
        and "a ∈∘ π’Ÿβˆ˜ S"
        and "b ∈∘ π’Ÿβˆ˜ T"
      by auto
    then obtain c d where "⟨a, c⟩ ∈∘ S" and "⟨b, d⟩ ∈∘ T" by force
    then have "⟨⟨a, b⟩, ⟨c, d⟩⟩ ∈∘ prod_2_Rel_ArrVal S T"
      by (intro prod_2_Rel_ArrValI) auto
    then show "ab ∈∘ π’Ÿβˆ˜ (prod_2_Rel_ArrVal S T)"
      unfolding ab_def by auto
  qed
qed (use prod_2_Rel_ArrVal_vsubset_vprod in blast)

lemma prod_2_Rel_ArrVal_vrange: "β„›βˆ˜ (prod_2_Rel_ArrVal S T) = β„›βˆ˜ S Γ—βˆ˜ β„›βˆ˜ T"
proof(intro vsubset_antisym)
  show "β„›βˆ˜ S Γ—βˆ˜ β„›βˆ˜ T βŠ†βˆ˜ β„›βˆ˜ (prod_2_Rel_ArrVal S T)"
  proof(intro vsubsetI)
    fix cd assume "cd ∈∘ β„›βˆ˜ S Γ—βˆ˜ β„›βˆ˜ T"
    then obtain c d
      where cd_def: "cd = ⟨c, d⟩" 
        and "c ∈∘ β„›βˆ˜ S"
        and "d ∈∘ β„›βˆ˜ T"
      by auto
    then obtain a b where "⟨a, c⟩ ∈∘ S" and "⟨b, d⟩ ∈∘ T" by force
    then have "⟨⟨a, b⟩, ⟨c, d⟩⟩ ∈∘ prod_2_Rel_ArrVal S T"
      by (intro prod_2_Rel_ArrValI) auto
    then show "cd ∈∘ β„›βˆ˜ (prod_2_Rel_ArrVal S T)"
      unfolding cd_def by auto
  qed
qed (use prod_2_Rel_ArrVal_vsubset_vprod in blast)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma 
  assumes "vsv g" and "vsv f"
  shows prod_2_Rel_ArrVal_vsv: "vsv (prod_2_Rel_ArrVal g f)"
    and prod_2_Rel_ArrVal_app: 
      "β‹€a b. ⟦ a ∈∘ π’Ÿβˆ˜ g; b ∈∘ π’Ÿβˆ˜ f ⟧ ⟹ 
        prod_2_Rel_ArrVal g fβ¦‡βŸ¨a,b⟩⦈ = ⟨g⦇a⦈, f⦇b⦈⟩"
proof-
  interpret g: vsv g by (rule assms(1))
  interpret f: vsv f by (rule assms(2))
  show vsv_gf: "vsv (prod_2_Rel_ArrVal g f)"
    by (intro vsvI; (elim prod_2_Rel_ArrValE)?; (unfold prod_2_Rel_ArrVal_def)?)
      (auto simp: g.vsv f.vsv)
  fix a b assume "a ∈∘ π’Ÿβˆ˜ g" "b ∈∘ π’Ÿβˆ˜ f"
  then have a_ga: "⟨a, g⦇a⦈⟩ ∈∘ g" and b_fb: "⟨b, f⦇b⦈⟩ ∈∘ f" by auto
  from a_ga b_fb show "prod_2_Rel_ArrVal g fβ¦‡βŸ¨a, b⟩⦈ = ⟨g⦇a⦈, f⦇b⦈⟩"
    by (cs_concl cs_simp: vsv.vsv_appI[OF vsv_gf] cs_intro: prod_2_Rel_ArrValI)
qed

lemma prod_2_Rel_ArrVal_v11:
  assumes "v11 g" and "v11 f"
  shows "v11 (prod_2_Rel_ArrVal g f)"
proof-
  interpret g: v11 g by (rule assms(1))
  interpret f: v11 f by (rule assms(2))
  show ?thesis
  proof
    (
      intro vsv.vsv_valeq_v11I prod_2_Rel_ArrVal_vsv g.vsv_axioms f.vsv_axioms, 
      unfold prod_2_Rel_ArrVal_vdomain
    )
    fix ab cd
    assume prems:
      "ab ∈∘ π’Ÿβˆ˜ g Γ—βˆ˜ π’Ÿβˆ˜ f"  
      "cd ∈∘ π’Ÿβˆ˜ g Γ—βˆ˜ π’Ÿβˆ˜ f"
      "prod_2_Rel_ArrVal g f⦇ab⦈ = prod_2_Rel_ArrVal g f⦇cd⦈"
    from prems(1) obtain a b
      where ab_def: "ab = ⟨a, b⟩" and a: "a ∈∘ π’Ÿβˆ˜ g" and b: "b ∈∘ π’Ÿβˆ˜ f"
      by auto
    from prems(2) obtain c d
      where cd_def: "cd = ⟨c, d⟩" and c: "c ∈∘ π’Ÿβˆ˜ g" and d: "d ∈∘ π’Ÿβˆ˜ f"
      by auto
    from prems(3) a b c d have "⟨g⦇a⦈, f⦇b⦈⟩ = ⟨g⦇c⦈, f⦇d⦈⟩"
      unfolding ab_def cd_def
      by (cs_prems cs_simp: prod_2_Rel_ArrVal_app cs_intro: V_cs_intros)    
    then have "g⦇a⦈ = g⦇c⦈" and "f⦇b⦈ = f⦇d⦈" by simp_all
    then show "ab = cd"
      by (auto simp: ab_def cd_def a b c d f.v11_injective g.v11_injective)
  qed
qed

lemma prod_2_Rel_ArrVal_vcomp:
  "prod_2_Rel_ArrVal S' T' ∘∘ prod_2_Rel_ArrVal S T =
    prod_2_Rel_ArrVal (S' ∘∘ S) (T' ∘∘ T)"
proof-
  interpret ST': vbrelation β€Ήprod_2_Rel_ArrVal S' T'β€Ί
    by (rule prod_2_Rel_ArrVal_vbrelation)
  interpret ST: vbrelation β€Ήprod_2_Rel_ArrVal S Tβ€Ί
    by (rule prod_2_Rel_ArrVal_vbrelation)
  show ?thesis (*TODO: simplify proof*)
  proof(intro vsubset_antisym vsubsetI)
    fix aa'_cc' assume 
      "aa'_cc' ∈∘ prod_2_Rel_ArrVal S' T' ∘∘ prod_2_Rel_ArrVal S T"
    then obtain aa' bb' cc' where ac_def: "aa'_cc' = ⟨aa', cc'⟩" 
      and bc: "⟨bb', cc'⟩ ∈∘ prod_2_Rel_ArrVal S' T'"
      and ab: "⟨aa', bb'⟩ ∈∘ prod_2_Rel_ArrVal S T"
      by auto
    from bc obtain b b' c c' 
      where bb'_cc'_def: "⟨bb', cc'⟩ = ⟨⟨b, b'⟩, ⟨c, c'⟩⟩"
        and bc: "⟨b, c⟩ ∈∘ S'"
        and bc': "⟨b', c'⟩ ∈∘ T'"
      by auto
    with ab obtain a a' 
      where aa'_bb'_def: "⟨aa', bb'⟩ = ⟨⟨a, a'⟩, ⟨b, b'⟩⟩"
        and ab: "⟨a, b⟩ ∈∘ S"
        and ab': "⟨a', b'⟩ ∈∘ T"
      by auto
    from bb'_cc'_def have bb'_def: "bb' = ⟨b, b'⟩" and cc'_def: "cc' = ⟨c, c'⟩"
      by simp_all
    from aa'_bb'_def have aa'_def: "aa' = ⟨a, a'⟩" and bb'_def: "bb' = ⟨b, b'⟩"
      by simp_all
    from bc bc' ab ab' show "aa'_cc' ∈∘ prod_2_Rel_ArrVal (S' ∘∘ S) (T' ∘∘ T)"
      unfolding ac_def aa'_def cc'_def
      by (intro prod_2_Rel_ArrValI)
        (cs_concl cs_intro: prod_2_Rel_ArrValI vcompI)+
  next
    fix aa'_cc' assume "aa'_cc' ∈∘ prod_2_Rel_ArrVal (S' ∘∘ S) (T' ∘∘ T)"
    then obtain a a' c c'
      where aa'_cc'_def: "aa'_cc' = ⟨⟨a, a'⟩, ⟨c, c'⟩⟩"
        and ac: "⟨a, c⟩ ∈∘ S' ∘∘ S"
        and ac': "⟨a', c'⟩ ∈∘ T' ∘∘ T"
      by blast
    from ac obtain b where ab: "⟨a, b⟩ ∈∘ S" and bc: "⟨b, c⟩ ∈∘ S'" 
      by auto
    from ac' obtain b' where ab': "⟨a', b'⟩ ∈∘ T" and bc': "⟨b', c'⟩ ∈∘ T'" 
      by auto
    from ab bc ab' bc' show 
      "aa'_cc' ∈∘ prod_2_Rel_ArrVal S' T' ∘∘ prod_2_Rel_ArrVal S T"
      unfolding aa'_cc'_def by (cs_concl cs_intro: vcompI prod_2_Rel_ArrValI)
  qed
qed

lemma prod_2_Rel_ArrVal_vid_on[cat_cs_simps]:
  "prod_2_Rel_ArrVal (vid_on A) (vid_on B) = vid_on (A Γ—βˆ˜ B)"
  unfolding prod_2_Rel_ArrVal_def by auto



subsectionβ€ΉProduct arrow for β€ΉRelβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition prod_2_Rel :: "V β‡’ V β‡’ V"
  where "prod_2_Rel S T =
    [
      prod_2_Rel_ArrVal (S⦇ArrVal⦈) (T⦇ArrVal⦈),
      S⦇ArrDom⦈ Γ—βˆ˜ T⦇ArrDom⦈,
      S⦇ArrCod⦈ Γ—βˆ˜ T⦇ArrCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma prod_2_Rel_components: 
  shows "prod_2_Rel S T⦇ArrVal⦈ = prod_2_Rel_ArrVal (S⦇ArrVal⦈) (T⦇ArrVal⦈)"
    and [cat_cs_simps]: "prod_2_Rel S T⦇ArrDom⦈ = S⦇ArrDom⦈ Γ—βˆ˜ T⦇ArrDom⦈"
    and [cat_cs_simps]: "prod_2_Rel S T⦇ArrCod⦈ = S⦇ArrCod⦈ Γ—βˆ˜ T⦇ArrCod⦈"
  unfolding prod_2_Rel_def arr_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉProduct arrow for β€ΉRelβ€Ί is an arrow in β€ΉRelβ€Ίβ€Ί

lemma prod_2_Rel_is_cat_Rel_arr:
  assumes "S : A ↦cat_Rel Ξ± B" and "T : C ↦cat_Rel Ξ± D"    
  shows "prod_2_Rel S T : A Γ—βˆ˜ C ↦cat_Rel Ξ± B Γ—βˆ˜ D"
proof-
  note S = cat_Rel_is_arrD[OF assms(1)]
  note T = cat_Rel_is_arrD[OF assms(2)]
  interpret S: arr_Rel Ξ± S 
    rewrites [simp]: "S⦇ArrDom⦈ = A" and [simp]: "S⦇ArrCod⦈ = B"
    by (simp_all add: S)
  interpret T: arr_Rel Ξ± T 
    rewrites [simp]: "T⦇ArrDom⦈ = C" and [simp]: "T⦇ArrCod⦈ = D"
    by (simp_all add: T)
  show ?thesis
  proof(intro cat_Rel_is_arrI arr_RelI)
    show "vfsequence (prod_2_Rel S T)"
      unfolding prod_2_Rel_def by simp
    show "vcard (prod_2_Rel S T) = 3β„•"
      unfolding prod_2_Rel_def by (simp add: nat_omega_simps)
    from S have "π’Ÿβˆ˜ (S⦇ArrVal⦈) βŠ†βˆ˜ A" and "β„›βˆ˜ (S⦇ArrVal⦈) βŠ†βˆ˜ B" by auto
    moreover from T have "π’Ÿβˆ˜ (T⦇ArrVal⦈) βŠ†βˆ˜ C" and "β„›βˆ˜ (T⦇ArrVal⦈) βŠ†βˆ˜ D" 
      by auto
    ultimately have 
      "π’Ÿβˆ˜ (S⦇ArrVal⦈) Γ—βˆ˜ π’Ÿβˆ˜ (T⦇ArrVal⦈) βŠ†βˆ˜ A Γ—βˆ˜ C"
      "β„›βˆ˜ (S⦇ArrVal⦈) Γ—βˆ˜ β„›βˆ˜ (T⦇ArrVal⦈) βŠ†βˆ˜ B Γ—βˆ˜ D"
      by auto
    then show 
      "π’Ÿβˆ˜ (prod_2_Rel S T⦇ArrVal⦈) βŠ†βˆ˜ prod_2_Rel S T⦇ArrDom⦈"
      "β„›βˆ˜ (prod_2_Rel S T⦇ArrVal⦈) βŠ†βˆ˜ prod_2_Rel S T⦇ArrCod⦈"
      unfolding 
        prod_2_Rel_components prod_2_Rel_ArrVal_vdomain prod_2_Rel_ArrVal_vrange
      by (force simp: prod_2_Rel_components)+
    from 
      S.arr_Rel_ArrDom_in_Vset T.arr_Rel_ArrDom_in_Vset
      S.arr_Rel_ArrCod_in_Vset T.arr_Rel_ArrCod_in_Vset
    show "prod_2_Rel S T⦇ArrDom⦈ ∈∘ Vset Ξ±" "prod_2_Rel S T⦇ArrCod⦈ ∈∘ Vset Ξ±"
      unfolding prod_2_Rel_components 
      by (allβ€Ήintro Limit_vtimes_in_VsetIβ€Ί) auto
  qed (auto simp: prod_2_Rel_components intro: prod_2_Rel_ArrVal_vbrelation)
qed

lemma prod_2_Rel_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
  assumes "S : A ↦cat_Rel Ξ± B"
    and "T : C ↦cat_Rel Ξ± D"
    and "A' = A Γ—βˆ˜ C"
    and "B' = B Γ—βˆ˜ D"
    and "β„­' = cat_Rel Ξ±"
  shows "prod_2_Rel S T : A' ↦ℭ' B'"
  using assms(1,2) unfolding assms(3-5) by (rule prod_2_Rel_is_cat_Rel_arr)


subsubsectionβ€ΉProduct arrow for β€ΉRelβ€Ί is an arrow in β€ΉSetβ€Ίβ€Ί

lemma prod_2_Rel_app[cat_rel_par_Set_cs_simps]:
  assumes "S : A ↦cat_Set Ξ± B" 
    and "T : C ↦cat_Set Ξ± D"    
    and "a ∈∘ A"
    and "c ∈∘ C"
    and "ac = ⟨a, c⟩"
  shows "prod_2_Rel S T⦇ArrValβ¦ˆβ¦‡ac⦈ = ⟨S⦇ArrValβ¦ˆβ¦‡a⦈, T⦇ArrValβ¦ˆβ¦‡c⦈⟩"
proof-
  note S = cat_Set_is_arrD[OF assms(1)]
  note T = cat_Set_is_arrD[OF assms(2)]
  interpret S: arr_Set Ξ± S 
    rewrites [simp]: "S⦇ArrDom⦈ = A" and [simp]: "S⦇ArrCod⦈ = B"
    by (simp_all add: S)
  interpret T: arr_Set Ξ± T 
    rewrites [simp]: "T⦇ArrDom⦈ = C" and [simp]: "T⦇ArrCod⦈ = D"
    by (simp_all add: T)
  from assms(3,4) show ?thesis
    unfolding prod_2_Rel_components(1) assms(5)
    by 
      (
        cs_concl 
          cs_simp: 
            S.arr_Set_ArrVal_vdomain 
            T.arr_Set_ArrVal_vdomain 
            prod_2_Rel_ArrVal_app 
          cs_intro: V_cs_intros
      )
qed

lemma prod_2_Rel_is_cat_Set_arr:
  assumes "S : A ↦cat_Set Ξ± B" and "T : C ↦cat_Set Ξ± D"    
  shows "prod_2_Rel S T : A Γ—βˆ˜ C ↦cat_Set Ξ± B Γ—βˆ˜ D"
proof-

  note S = cat_Set_is_arrD[OF assms(1)]
  note T = cat_Set_is_arrD[OF assms(2)]

  interpret S: arr_Set Ξ± S 
    rewrites [simp]: "S⦇ArrDom⦈ = A" and [simp]: "S⦇ArrCod⦈ = B"
    by (simp_all add: S)
  interpret T: arr_Set Ξ± T 
    rewrites [simp]: "T⦇ArrDom⦈ = C" and [simp]: "T⦇ArrCod⦈ = D"
    by (simp_all add: T)

  show ?thesis
  proof(intro cat_Set_is_arrI arr_SetI)
    show "vfsequence (prod_2_Rel S T)"
      unfolding prod_2_Rel_def by simp
    show "vcard (prod_2_Rel S T) = 3β„•"
      unfolding prod_2_Rel_def by (simp add: nat_omega_simps)
    from S.arr_Set_ArrVal_vrange T.arr_Set_ArrVal_vrange show 
      "β„›βˆ˜ (prod_2_Rel S T⦇ArrVal⦈) βŠ†βˆ˜ prod_2_Rel S T⦇ArrCod⦈"
      unfolding 
        prod_2_Rel_components prod_2_Rel_ArrVal_vdomain prod_2_Rel_ArrVal_vrange
      by auto
    from assms S.arr_Par_ArrDom_in_Vset T.arr_Par_ArrDom_in_Vset show 
      "prod_2_Rel S T⦇ArrDom⦈ ∈∘ Vset Ξ±"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
    from assms S.arr_Par_ArrCod_in_Vset T.arr_Par_ArrCod_in_Vset show 
      "prod_2_Rel S T⦇ArrCod⦈ ∈∘ Vset Ξ±"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
    from assms show "prod_2_Rel S T⦇ArrDom⦈ = A Γ—βˆ˜ C"
      by (cs_concl cs_simp: cat_cs_simps)
    from assms show "prod_2_Rel S T⦇ArrCod⦈ = B Γ—βˆ˜ D"
      by (cs_concl cs_simp: cat_cs_simps)
    show "vsv (prod_2_Rel S T⦇ArrVal⦈)"
      unfolding prod_2_Rel_components
      by (intro prod_2_Rel_ArrVal_vsv S.ArrVal.vsv_axioms T.ArrVal.vsv_axioms)
  qed 
    (
      auto simp: 
        cat_cs_simps cat_Set_cs_simps 
        prod_2_Rel_ArrVal_vdomain prod_2_Rel_components(1)
    )

qed

lemma prod_2_Rel_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
  assumes "S : A ↦cat_Set Ξ± B" 
    and "T : C ↦cat_Set Ξ± D"
    and "AC = A Γ—βˆ˜ C"
    and "BD = B Γ—βˆ˜ D"
    and "β„­' = cat_Set Ξ±"
  shows "prod_2_Rel S T : AC ↦ℭ' BD"
  using assms(1,2) unfolding assms(3-5) by (rule prod_2_Rel_is_cat_Set_arr)


subsubsectionβ€ΉProduct arrow for β€ΉRelβ€Ί is an isomorphism in β€ΉSetβ€Ίβ€Ί

lemma prod_2_Rel_is_cat_Set_arr_isomorphism:
  assumes "S : A ↦isocat_Set Ξ± B" and "T : C ↦isocat_Set Ξ± D"    
  shows "prod_2_Rel S T : A Γ—βˆ˜ C ↦isocat_Set Ξ± B Γ—βˆ˜ D"
proof-
  note S = cat_Set_is_arr_isomorphismD[OF assms(1)]
  note T = cat_Set_is_arr_isomorphismD[OF assms(2)]
  show ?thesis
  proof
    (
      intro cat_Set_is_arr_isomorphismI prod_2_Rel_is_cat_Set_arr[OF S(1) T(1)], 
      unfold prod_2_Rel_components
    )
    show "π’Ÿβˆ˜ (prod_2_Rel_ArrVal (S⦇ArrVal⦈) (T⦇ArrVal⦈)) = A Γ—βˆ˜ C"
      unfolding prod_2_Rel_ArrVal_vdomain
      by (cs_concl cs_simp: S(3) T(3) cs_intro: cat_cs_intros)
    show "β„›βˆ˜ (prod_2_Rel_ArrVal (S⦇ArrVal⦈) (T⦇ArrVal⦈)) = B Γ—βˆ˜ D"
      unfolding prod_2_Rel_ArrVal_vrange
      by (cs_concl cs_simp: S(4) T(4) cs_intro: cat_cs_intros)
  qed (use S(2) T(2) in β€Ήcs_concl cs_intro: prod_2_Rel_ArrVal_v11β€Ί)
qed

lemma prod_2_Rel_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
  assumes "S : A ↦isocat_Set Ξ± B" 
    and "T : C ↦isocat_Set Ξ± D"    
    and "AC = A Γ—βˆ˜ C"
    and "BD = B Γ—βˆ˜ D"
    and "β„­' = cat_Set Ξ±"
  shows "prod_2_Rel S T : AC ↦isoβ„­' BD"
  using assms(1,2) 
  unfolding assms(3-5) 
  by (rule prod_2_Rel_is_cat_Set_arr_isomorphism)


subsubsectionβ€ΉFurther elementary propertiesβ€Ί

lemma prod_2_Rel_Comp:
  assumes "G' : B' ↦cat_Rel Ξ± B''" 
    and "F' : A' ↦cat_Rel Ξ± A''" 
    and "G : B ↦cat_Rel Ξ± B'"
    and "F : A ↦cat_Rel Ξ± A'"
  shows
    "prod_2_Rel G' F' ∘Acat_Rel α prod_2_Rel G F =
      prod_2_Rel (G' ∘Acat_Rel α G) (F' ∘Acat_Rel α F)"
proof-

  from cat_Rel_is_arrD(1)[OF assms(1)] interpret 𝒡 Ξ± by auto

  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
  note (*prefer cat_Rel*)[cat_cs_simps] = cat_Rel_is_arrD(2,3)

  from assms have GF'_GF: 
    "prod_2_Rel G' F' ∘Acat_Rel α prod_2_Rel G F :
      B Γ—βˆ˜ A ↦cat_Rel Ξ± B'' Γ—βˆ˜ A''"
    by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
  from assms Rel.category_axioms have GG'_FF':
    "prod_2_Rel (G' ∘Acat_Rel α G) (F' ∘Acat_Rel α F) : 
      B Γ—βˆ˜ A ↦cat_Rel Ξ± B'' Γ—βˆ˜ A''"
    by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)

  show ?thesis
  proof(rule arr_Rel_eqI[of Ξ±])
    from GF'_GF show arr_Rel_GF'_GF:
      "arr_Rel α (prod_2_Rel G' F' ∘Acat_Rel α prod_2_Rel G F)"
      by (auto dest: cat_Rel_is_arrD(1))
    from GG'_FF' show arr_Rel_GG'_FF':
      "arr_Rel α (prod_2_Rel (G' ∘Acat_Rel α G) (F' ∘Acat_Rel α F))"
      by (auto dest: cat_Rel_is_arrD(1))
    show "(prod_2_Rel G' F' ∘Acat_Rel Ξ± prod_2_Rel G F)⦇ArrVal⦈ = 
      prod_2_Rel (G' ∘Acat_Rel Ξ± G) (F' ∘Acat_Rel Ξ± F)⦇ArrVal⦈"
    proof(intro vsubset_antisym vsubsetI)
      fix R assume
        "R ∈∘ (prod_2_Rel G' F' ∘Acat_Rel Ξ± prod_2_Rel G F)⦇ArrVal⦈"
      from this assms have "R ∈∘
        prod_2_Rel_ArrVal (G'⦇ArrVal⦈) (F'⦇ArrVal⦈) ∘∘
        prod_2_Rel_ArrVal (G⦇ArrVal⦈) (F⦇ArrVal⦈)"
        by 
          (
            cs_prems 
              cs_simp: 
                prod_2_Rel_components(1) 
                comp_Rel_components(1)
                cat_Rel_cs_simps 
              cs_intro: cat_Rel_par_set_cs_intros
          )
      from this[unfolded prod_2_Rel_ArrVal_vcomp] assms show 
        "R ∈∘ prod_2_Rel (G' ∘Acat_Rel Ξ± G) (F' ∘Acat_Rel Ξ± F)⦇ArrVal⦈"
        by 
          (
            cs_concl cs_simp: 
              prod_2_Rel_components comp_Rel_components(1) cat_Rel_cs_simps 
          )
    next
      fix R assume
        "R ∈∘ prod_2_Rel (G' ∘Acat_Rel Ξ± G) (F' ∘Acat_Rel Ξ± F)⦇ArrVal⦈"
      from this assms have 
        "R ∈∘ prod_2_Rel_ArrVal (G'⦇ArrVal⦈ ∘∘ G⦇ArrVal⦈) (F'⦇ArrVal⦈ ∘∘ F⦇ArrVal⦈)"
        by 
          (
            cs_prems cs_simp:
              comp_Rel_components prod_2_Rel_components cat_Rel_cs_simps
          )
      from this[folded prod_2_Rel_ArrVal_vcomp] assms show
        "R ∈∘ (prod_2_Rel G' F' ∘Acat_Rel Ξ± prod_2_Rel G F)⦇ArrVal⦈"
        by
          (
            cs_concl 
              cs_simp:
                prod_2_Rel_components comp_Rel_components(1) cat_Rel_cs_simps 
              cs_intro: cat_Rel_par_set_cs_intros
          )
    qed

  qed
    (
      use GF'_GF assms in (*slow*)
        β€Ή
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_cs_intros cat_Rel_cs_intros
        β€Ί
    )+

qed

lemma (in 𝒡) prod_2_Rel_CId[cat_cs_simps]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" and "B ∈∘ cat_Rel α⦇Obj⦈"
  shows 
    "prod_2_Rel (cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈) (cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈) = cat_Rel α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ B⦈"
proof-
  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί by (rule category_cat_Rel)
  from assms have A_B: 
    "prod_2_Rel (cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈) (cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈) :
      A Γ—βˆ˜ B ↦cat_Rel Ξ± A Γ—βˆ˜ B"
    by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
  from assms Rel.category_axioms have AB:
    "cat_Rel α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ B⦈ : A Γ—βˆ˜ B ↦cat_Rel Ξ± A Γ—βˆ˜ B"
    by 
      (
        cs_concl 
          cs_simp: cat_Rel_components(1) cs_intro: V_cs_intros cat_cs_intros
      )
  show ?thesis
  proof(rule arr_Rel_eqI)
    from A_B show arr_Rel_GF'_GF:
      "arr_Rel Ξ± (prod_2_Rel (cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈) (cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈))"
      by (auto dest: cat_Rel_is_arrD(1))
    from AB show arr_Rel_GG'_FF': "arr_Rel Ξ± (cat_Rel α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ B⦈)"
      by (auto dest: cat_Rel_is_arrD(1))
    from assms show 
      "prod_2_Rel (cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈) (cat_Rel α⦇CIdβ¦ˆβ¦‡B⦈)⦇ArrVal⦈ =
        cat_Rel α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ Bβ¦ˆβ¦‡ArrVal⦈"
      by
        (
          cs_concl
            cs_simp:
              id_Rel_components prod_2_Rel_components
              cat_cs_simps cat_Rel_cs_simps 
            cs_intro: V_cs_intros  cat_cs_intros 
        )
  qed 
    (
      use A_B assms in 
        β€Ή
          cs_concl
            cs_simp: prod_2_Rel_components cat_Rel_cs_simps 
            cs_intro: cat_cs_intros 
        β€Ί
    )+
qed



subsectionβ€ΉProduct functor for β€ΉRelβ€Ίβ€Ί

definition cf_prod_2_Rel :: "V β‡’ V"
  where "cf_prod_2_Rel 𝔄 =
    [
      (Ξ»AB∈∘(𝔄 Γ—C 𝔄)⦇Obj⦈. AB⦇0⦈ Γ—βˆ˜ AB⦇1β„•β¦ˆ),
      (Ξ»ST∈∘(𝔄 Γ—C 𝔄)⦇Arr⦈. prod_2_Rel (ST⦇0⦈) (ST⦇1β„•β¦ˆ)),
      𝔄 Γ—C 𝔄,
      𝔄
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_prod_2_Rel_components: 
  shows "cf_prod_2_Rel 𝔄⦇ObjMap⦈ = (Ξ»AB∈∘(𝔄 Γ—C 𝔄)⦇Obj⦈. AB⦇0⦈ Γ—βˆ˜ AB⦇1β„•β¦ˆ)"
    and "cf_prod_2_Rel 𝔄⦇ArrMap⦈ =
      (Ξ»ST∈∘(𝔄 Γ—C 𝔄)⦇Arr⦈. prod_2_Rel (ST⦇0⦈) (ST⦇1β„•β¦ˆ))"
    and [cat_cs_simps]: "cf_prod_2_Rel 𝔄⦇HomDom⦈ = 𝔄 Γ—C 𝔄"
    and [cat_cs_simps]: "cf_prod_2_Rel 𝔄⦇HomCod⦈ = 𝔄"
  unfolding cf_prod_2_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda cf_prod_2_Rel_components(1)
  |vsv cf_prod_2_Rel_ObjMap_vsv[cat_cs_intros]|
  |vdomain cf_prod_2_Rel_ObjMap_vdomain[cat_cs_simps]|

lemma cf_prod_2_Rel_ObjMap_app[cat_cs_simps]: 
  assumes "AB = [A, B]∘" and "AB ∈∘ (𝔄 Γ—C 𝔄)⦇Obj⦈"
  shows "A βŠ—HM.Ocf_prod_2_Rel 𝔄 B = A Γ—βˆ˜ B"
  using assms(2) 
  unfolding assms(1) cf_prod_2_Rel_components 
  by (simp add: nat_omega_simps)

lemma (in 𝒡) cf_prod_2_Rel_ObjMap_vrange: 
  "β„›βˆ˜ (cf_prod_2_Rel (cat_Rel Ξ±)⦇ObjMap⦈) βŠ†βˆ˜ cat_Rel α⦇Obj⦈"
proof-
  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
  show ?thesis
  proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
    fix AB assume prems: "AB ∈∘ (cat_Rel Ξ± Γ—C cat_Rel Ξ±)⦇Obj⦈"
    with Rel.category_axioms obtain A B where AB_def: "AB = [A, B]∘"
      and A: "A ∈∘ cat_Rel α⦇Obj⦈"
      and B: "B ∈∘ cat_Rel α⦇Obj⦈"
      by (elim cat_prod_2_ObjE[rotated 2])
    from prems A B show "cf_prod_2_Rel (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡AB⦈ ∈∘ cat_Rel α⦇Obj⦈"
      unfolding AB_def cat_Rel_components(1)
      by (cs_concl cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: V_cs_intros)
  qed (cs_concl cs_intro: cat_cs_intros)
qed


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda cf_prod_2_Rel_components(2)
  |vsv cf_prod_2_Rel_ArrMap_vsv[cat_cs_intros]|
  |vdomain cf_prod_2_Rel_ArrMap_vdomain[cat_cs_simps]|

lemma cf_prod_2_Rel_ArrMap_app[cat_cs_simps]: 
  assumes "GF = [G, F]∘" and "GF ∈∘ (𝔄 Γ—C 𝔄)⦇Arr⦈"
  shows "G βŠ—HM.Acf_prod_2_Rel 𝔄 F = prod_2_Rel G F"
  using assms(2) 
  unfolding assms(1) cf_prod_2_Rel_components 
  by (simp add: nat_omega_simps)


subsubsectionβ€ΉProduct functor for β€ΉRelβ€Ί is a functorβ€Ί

lemma (in 𝒡) cf_prod_2_Rel_is_functor:
  "cf_prod_2_Rel (cat_Rel Ξ±) : cat_Rel Ξ± Γ—C cat_Rel Ξ± ↦↦CΞ± cat_Rel Ξ±"
proof-

  interpret Rel: category Ξ± β€Ήcat_Rel Ξ±β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)

  show ?thesis
  proof(rule is_functorI')
   show "vfsequence (cf_prod_2_Rel (cat_Rel Ξ±))"
      unfolding cf_prod_2_Rel_def by auto
    show "vcard (cf_prod_2_Rel (cat_Rel Ξ±)) = 4β„•"
      unfolding cf_prod_2_Rel_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (cf_prod_2_Rel (cat_Rel Ξ±)⦇ObjMap⦈) βŠ†βˆ˜ cat_Rel α⦇Obj⦈"
      by (rule cf_prod_2_Rel_ObjMap_vrange)
    show "cf_prod_2_Rel (cat_Rel Ξ±)⦇ArrMapβ¦ˆβ¦‡GF⦈ :
      cf_prod_2_Rel (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡AB⦈ ↦cat_Rel Ξ±
      cf_prod_2_Rel (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡CD⦈"
      if "GF : AB ↦cat_Rel Ξ± Γ—C cat_Rel Ξ± CD" for AB CD GF
    proof-
      from that obtain G F A B C D
        where GF_def: "GF = [G, F]∘"
          and AB_def: "AB = [A, B]∘"
          and CD_def: "CD = [C, D]∘"
          and G: "G : A ↦cat_Rel Ξ± C"
          and F: "F : B ↦cat_Rel Ξ± D"
        by (elim cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms])
      from that G F show ?thesis
        unfolding GF_def AB_def CD_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps 
              cs_intro: 
                cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
          )
    qed

    show 
      "cf_prod_2_Rel (cat_Rel Ξ±)⦇ArrMapβ¦ˆβ¦‡GF' ∘Acat_Rel Ξ± Γ—C cat_Rel Ξ± GF⦈ =
        cf_prod_2_Rel (cat_Rel Ξ±)⦇ArrMapβ¦ˆβ¦‡GF'⦈ ∘Acat_Rel Ξ±
          cf_prod_2_Rel (cat_Rel Ξ±)⦇ArrMapβ¦ˆβ¦‡GF⦈"
      if "GF' : AB' ↦cat_Rel Ξ± Γ—C cat_Rel Ξ± AB''"
        and "GF : AB ↦cat_Rel Ξ± Γ—C cat_Rel Ξ± AB'"
      for AB' AB'' GF' AB GF
    proof-
      from that(2) obtain G F A A' B B' 
        where GF_def: "GF = [G, F]∘"
          and AB_def: "AB = [A, B]∘"
          and AB'_def: "AB' = [A', B']∘"
          and G: "G : A ↦cat_Rel Ξ± A'"
          and F: "F : B ↦cat_Rel Ξ± B'"
        by (elim cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms])
      with that(1) obtain G' F' A'' B''
        where GF'_def: "GF' = [G', F']∘"
          and AB''_def: "AB'' = [A'', B'']∘"
          and G': "G' : A' ↦cat_Rel Ξ± A''"
          and F': "F' : B' ↦cat_Rel Ξ± B''"
        by 
          (
            auto elim: 
              cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms]
          )
      from that G F G' F' show ?thesis
        unfolding GF_def AB_def AB'_def GF'_def AB''_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_prod_cs_simps prod_2_Rel_Comp
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed

    show 
      "cf_prod_2_Rel (cat_Rel Ξ±)⦇ArrMapβ¦ˆβ¦‡(cat_Rel Ξ± Γ—C cat_Rel Ξ±)⦇CIdβ¦ˆβ¦‡AB⦈⦈ =
        cat_Rel α⦇CIdβ¦ˆβ¦‡cf_prod_2_Rel (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡AB⦈⦈"
      if "AB ∈∘ (cat_Rel Ξ± Γ—C cat_Rel Ξ±)⦇Obj⦈" for AB 
    proof-
      from that obtain A B 
        where AB_def: "AB = [A, B]∘"
          and A: "A ∈∘ cat_Rel α⦇Obj⦈"
          and B: "B ∈∘ cat_Rel α⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF Rel.category_axioms Rel.category_axioms])
      from A B show ?thesis
        unfolding AB_def     
        by
          (
            cs_concl
              cs_simp:
                cf_prod_2_Rel_ObjMap_app cf_prod_2_Rel_ArrMap_app
                cat_cs_simps cat_prod_cs_simps
              cs_intro:
                V_cs_intros cat_cs_intros cat_Rel_cs_intros cat_prod_cs_intros
          )
    qed

  qed
    (
      cs_concl
        cs_simp: cat_cs_simps 
        cs_intro: cat_cs_intros cat_cs_intros cat_Rel_cs_intros
    )+

qed

lemma (in 𝒡) cf_prod_2_Rel_is_functor'[cat_cs_intros]:
  assumes "𝔄' = cat_Rel Ξ± Γ—C cat_Rel Ξ±"
    and "𝔅' = cat_Rel Ξ±"
    and "Ξ±' = Ξ±"
  shows "cf_prod_2_Rel (cat_Rel Ξ±) : 𝔄' ↦↦CΞ±' 𝔅'"
  unfolding assms by (rule cf_prod_2_Rel_is_functor)

lemmas [cat_cs_intros] = 𝒡.cf_prod_2_Rel_is_functor'



subsectionβ€ΉProduct universal property arrow for β€ΉSetβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_Set_obj_prod_up :: "V β‡’ (V β‡’ V) β‡’ V β‡’ (V β‡’ V) β‡’ V"
  where "cat_Set_obj_prod_up I F A Ο† =
    [(Ξ»a∈∘A. (Ξ»i∈∘I. Ο† i⦇ArrValβ¦ˆβ¦‡a⦈)), A, (∏∘i∈∘I. F i)]∘"


textβ€ΉComponents.β€Ί

lemma cat_Set_obj_prod_up_components: 
  shows "cat_Set_obj_prod_up I F A φ⦇ArrVal⦈ = 
    (Ξ»a∈∘A. (Ξ»i∈∘I. Ο† i⦇ArrValβ¦ˆβ¦‡a⦈))"
    and [cat_Set_cs_simps]: 
      "cat_Set_obj_prod_up I F A φ⦇ArrDom⦈ = A"
    and [cat_Set_cs_simps]: 
      "cat_Set_obj_prod_up I F A φ⦇ArrCod⦈ = (∏∘i∈∘I. F i)"
  unfolding cat_Set_obj_prod_up_def arr_field_simps 
  by (simp_all add: nat_omega_simps)


textβ€ΉArrow value.β€Ί

mk_VLambda cat_Set_obj_prod_up_components(1)
  |vsv cat_Set_obj_prod_up_ArrVal_vsv[cat_Set_cs_intros]|
  |vdomain cat_Set_obj_prod_up_ArrVal_vdomain[cat_Set_cs_simps]|
  |app cat_Set_obj_prod_up_ArrVal_app|

lemma cat_Set_obj_prod_up_ArrVal_vrange: 
  assumes "β‹€i. i ∈∘ I ⟹ Ο† i : A ↦cat_Set Ξ± F i"
  shows "β„›βˆ˜ (cat_Set_obj_prod_up I F A φ⦇ArrVal⦈) βŠ†βˆ˜ (∏∘i∈∘I. F i)"
  unfolding cat_Set_obj_prod_up_components 
proof(intro vrange_VLambda_vsubset vproductI)
  fix a assume prems: "a ∈∘ A"
  show "βˆ€i∈∘I. (Ξ»i∈∘I. Ο† i⦇ArrValβ¦ˆβ¦‡a⦈)⦇i⦈ ∈∘ F i"
  proof(intro ballI)
    fix i assume "i ∈∘ I"
    with assms prems show "(Ξ»i∈∘I. Ο† i⦇ArrValβ¦ˆβ¦‡a⦈)⦇i⦈ ∈∘ F i"
      by (cs_concl cs_simp: V_cs_simps cs_intro: cat_Set_cs_intros)
  qed
qed auto

lemma cat_Set_obj_prod_up_ArrVal_app_vdomain[cat_Set_cs_simps]:
  assumes "a ∈∘ A"
  shows "π’Ÿβˆ˜ (cat_Set_obj_prod_up I F A φ⦇ArrValβ¦ˆβ¦‡a⦈) = I"
  unfolding cat_Set_obj_prod_up_ArrVal_app[OF assms] by simp

lemma cat_Set_obj_prod_up_ArrVal_app_component[cat_Set_cs_simps]: 
  assumes "a ∈∘ A" and "i ∈∘ I"
  shows "cat_Set_obj_prod_up I F A φ⦇ArrValβ¦ˆβ¦‡aβ¦ˆβ¦‡i⦈ = Ο† i⦇ArrValβ¦ˆβ¦‡a⦈"
  using assms 
  by (cs_concl cs_simp: cat_Set_obj_prod_up_ArrVal_app V_cs_simps)

lemma cat_Set_obj_prod_up_ArrVal_app_vrange: 
  assumes "a ∈∘ A" and "β‹€i. i ∈∘ I ⟹ Ο† i : A ↦cat_Set Ξ± F i"
  shows "β„›βˆ˜ (cat_Set_obj_prod_up I F A φ⦇ArrValβ¦ˆβ¦‡a⦈) βŠ†βˆ˜ (β‹ƒβˆ˜i∈∘I. F i)"
proof(intro vsubsetI)
  fix b assume prems: "b ∈∘ β„›βˆ˜ (cat_Set_obj_prod_up I F A φ⦇ArrValβ¦ˆβ¦‡a⦈)"
  from assms(1) have "vsv (cat_Set_obj_prod_up I F A φ⦇ArrValβ¦ˆβ¦‡a⦈)"
    by (auto simp: cat_Set_obj_prod_up_components)
  with prems obtain i 
    where b_def: "b = cat_Set_obj_prod_up I F A φ⦇ArrValβ¦ˆβ¦‡aβ¦ˆβ¦‡i⦈" 
      and i: "i ∈∘ I"
    by 
      ( 
        auto 
          elim: vsv.vrange_atE 
          simp: cat_Set_obj_prod_up_ArrVal_app[OF assms(1)]
      )
  from cat_Set_obj_prod_up_ArrVal_app_component[OF assms(1) i] b_def have b_def':
    "b = Ο† i⦇ArrValβ¦ˆβ¦‡a⦈"
    by simp
  from assms(1) assms(2)[OF i] have "b ∈∘ F i" 
    unfolding b_def' by (cs_concl cs_intro: cat_Set_cs_intros)
  with i show "b ∈∘ (β‹ƒβˆ˜i∈∘I. F i)" by force
qed


subsubsectionβ€ΉProduct universal property arrow for β€ΉSetβ€Ί is an arrow in β€ΉSetβ€Ίβ€Ί

lemma (in 𝒡) cat_Set_obj_prod_up_cat_Set_is_arr:
  assumes "A ∈∘ Vset α" 
    and "VLambda I F ∈∘ Vset α" 
    and "β‹€i. i ∈∘ I ⟹ Ο† i : A ↦cat_Set Ξ± F i"
  shows "cat_Set_obj_prod_up I F A Ο† : A ↦cat_Set Ξ± (∏∘i∈∘I. F i)"
proof(intro cat_Set_is_arrI arr_SetI)
  show "vfsequence (cat_Set_obj_prod_up I F A Ο†)"
    unfolding cat_Set_obj_prod_up_def by auto
  show "vcard (cat_Set_obj_prod_up I F A Ο†) = 3β„•"
    unfolding cat_Set_obj_prod_up_def by (auto simp: nat_omega_simps)
  show 
    "β„›βˆ˜ (cat_Set_obj_prod_up I F A φ⦇ArrVal⦈) βŠ†βˆ˜
      cat_Set_obj_prod_up I F A φ⦇ArrCod⦈"
    unfolding cat_Set_obj_prod_up_components(3)
    by (rule cat_Set_obj_prod_up_ArrVal_vrange[OF assms(3)])
  show "cat_Set_obj_prod_up I F A φ⦇ArrCod⦈ ∈∘ Vset Ξ±"
    unfolding cat_Set_cs_simps
    by (rule Limit_vproduct_in_Vset_if_VLambda_in_VsetI)
      (simp_all add: cat_Set_cs_simps assms)
qed (auto simp: assms cat_Set_cs_simps intro: cat_Set_cs_intros)

lemma (in 𝒡) pdg_dghm_comp_dghm_proj_dghm_up: 
  assumes "A ∈∘ Vset α" 
    and "VLambda I F ∈∘ Vset α"
    and "β‹€i. i ∈∘ I ⟹ Ο† i : A ↦cat_Set Ξ± F i" 
    and "i ∈∘ I"
  shows 
    "Ο† i = vprojection_arrow I F i ∘Acat_Set Ξ± cat_Set_obj_prod_up I F A Ο†"
    (is β€ΉΟ† i = ?Fi ∘Acat_Set Ξ± ?Ο†β€Ί)
proof(rule arr_Set_eqI[of Ξ±])
  note Ο†i = assms(3)[OF assms(4)]
  note Ο†i = cat_Set_is_arrD[OF Ο†i] Ο†i
  have Fi: "?Fi : (∏∘i∈∘I. F i) ↦cat_Set Ξ± F i"
    by (rule vprojection_arrow_is_arr[OF assms(4,2)])
  from cat_Set_obj_prod_up_cat_Set_is_arr[OF assms(1,2,3)] have Ο†:
    "cat_Set_obj_prod_up I F A Ο† : A ↦cat_Set Ξ± (∏∘i∈∘I. F i)"
    by simp
  show "arr_Set Ξ± (Ο† i)" by (rule Ο†i(1))
  interpret Ο†i: arr_Set Ξ± β€ΉΟ† iβ€Ί by (rule Ο†i(1))
  from Fi Ο† have Fi_Ο†: "?Fi ∘Acat_Set Ξ± ?Ο† : A ↦cat_Set Ξ± F i"
    by (cs_concl cs_intro: cat_cs_intros)
  then show arr_Set_Fi_Ο†: "arr_Set Ξ± (?Fi ∘Acat_Set Ξ± ?Ο†)"
    by (auto simp: cat_Set_is_arrD(1))
  interpret arr_Set Ξ± β€Ή?Fi ∘Acat_Set Ξ± ?Ο†β€Ί by (rule arr_Set_Fi_Ο†)
  from Ο†i have dom_lhs: "π’Ÿβˆ˜ (Ο† i⦇ArrVal⦈) = A"
    by (cs_concl cs_simp: cat_cs_simps)
  from Fi_Ο† have dom_rhs: "π’Ÿβˆ˜ ((?Fi ∘Acat_Set Ξ± ?Ο†)⦇ArrVal⦈) = A"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "Ο† i⦇ArrVal⦈ = (?Fi ∘Acat_Set Ξ± ?Ο†)⦇ArrVal⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume prems: "a ∈∘ A"
    from assms(4) prems Ο†i(4) Ο† Fi show 
      "Ο† i⦇ArrValβ¦ˆβ¦‡a⦈ = (?Fi ∘Acat_Set Ξ± ?Ο†)⦇ArrValβ¦ˆβ¦‡a⦈"
      by 
        ( 
          cs_concl 
            cs_simp: cat_Set_cs_simps cat_cs_simps 
            cs_intro: cat_Set_cs_intros cat_cs_intros
        )
  qed auto
  from Fi Ο† show "Ο† i⦇ArrDom⦈ = (?Fi ∘Acat_Set Ξ± ?Ο†)⦇ArrDom⦈"
    by (cs_concl cs_simp: cat_cs_simps cat_Set_cs_simps Ο†i(2))
  from Fi Ο† show "Ο† i⦇ArrCod⦈ = (?Fi ∘Acat_Set Ξ± ?Ο†)⦇ArrCod⦈"
    by (cs_concl cs_simp: cat_cs_simps cat_Set_cs_simps Ο†i(3))
qed



subsectionβ€ΉEqualizer object for the category β€ΉSetβ€Ίβ€Ί


textβ€Ή
The definition of the (non-categorical concept of an) equalizer can be 
found in \cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
}β€Ί

definition vequalizer :: "V β‡’ V β‡’ V β‡’ V"
  where "vequalizer X f g = set {x. x ∈∘ X ∧ f⦇ArrValβ¦ˆβ¦‡x⦈ = g⦇ArrValβ¦ˆβ¦‡x⦈}"

lemma small_vequalizer[simp]: 
  "small {x. x ∈∘ X ∧ f⦇ArrValβ¦ˆβ¦‡x⦈ = g⦇ArrValβ¦ˆβ¦‡x⦈}"
  by auto


textβ€ΉRules.β€Ί

lemma vequalizerI:
  assumes "x ∈∘ X" and "f⦇ArrValβ¦ˆβ¦‡x⦈ = g⦇ArrValβ¦ˆβ¦‡x⦈"
  shows "x ∈∘ vequalizer X f g"
  using assms unfolding vequalizer_def by auto

lemma vequalizerD[dest]:
  assumes "x ∈∘ vequalizer X f g"
  shows "x ∈∘ X" and "f⦇ArrValβ¦ˆβ¦‡x⦈ = g⦇ArrValβ¦ˆβ¦‡x⦈"
  using assms unfolding vequalizer_def by auto

lemma vequalizerE[elim]:
  assumes "x ∈∘ vequalizer X f g"
  obtains "x ∈∘ X" and "f⦇ArrValβ¦ˆβ¦‡x⦈ = g⦇ArrValβ¦ˆβ¦‡x⦈"
  using assms unfolding vequalizer_def by auto


textβ€ΉElementary results.β€Ί

lemma vequalizer_vsubset_vdomain[cat_Set_cs_intros]: "vequalizer a g f βŠ†βˆ˜ a" 
  by auto
  
lemma Limit_vequalizer_in_Vset[cat_Set_cs_intros]:
  assumes "Limit α" and "a ∈∘ Vset α"
  shows "vequalizer a g f ∈∘ Vset α"
  using assms by auto

lemma vequalizer_flip: "vequalizer a f g = vequalizer a g f"
  unfolding vequalizer_def by auto

lemma (in 𝒡) cat_Set_incl_Set_commute:
  assumes "𝔀 : π”ž ↦cat_Set Ξ± π”Ÿ" and "𝔣 : π”ž ↦cat_Set Ξ± π”Ÿ" 
  shows 
    "𝔀 ∘Acat_Set Ξ± incl_Set (vequalizer π”ž 𝔣 𝔀) π”ž =
      𝔣 ∘Acat_Set Ξ± incl_Set (vequalizer π”ž 𝔣 𝔀) π”ž"
  (is ‹𝔀 ∘Acat_Set Ξ± ?incl = 𝔣 ∘Acat_Set Ξ± ?inclβ€Ί)
proof-

  note 𝔀 = cat_Set_is_arrD[OF assms(1)]
  interpret 𝔀: arr_Set Ξ± 𝔀 
    rewrites "𝔀⦇ArrDom⦈ = π”ž" and "𝔀⦇ArrCod⦈ = π”Ÿ"
    by (rule 𝔀(1)) (simp_all add: 𝔀)
  note 𝔣 = cat_Set_is_arrD[OF assms(2)]
  interpret 𝔣: arr_Set Ξ± 𝔣 
    rewrites "𝔣⦇ArrDom⦈ = π”ž" and "𝔣⦇ArrCod⦈ = π”Ÿ"
    by (rule 𝔣(1)) (simp_all add: 𝔣)

  note [cat_Set_cs_intros] = 𝔀.arr_Set_ArrDom_in_Vset 𝔣.arr_Set_ArrCod_in_Vset

  from assms have 𝔀_incl: 
    "𝔀 ∘Acat_Set Ξ± ?incl : vequalizer π”ž 𝔣 𝔀 ↦cat_Set Ξ± π”Ÿ"
    by (cs_concl cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
  then have dom_lhs: "π’Ÿβˆ˜ ((𝔀 ∘Acat_Set Ξ± ?incl)⦇ArrVal⦈) = vequalizer π”ž 𝔣 𝔀"
    by (cs_concl cs_simp: cat_cs_simps)+
  from assms have 𝔣_incl: 
    "𝔣 ∘Acat_Set Ξ± ?incl : vequalizer π”ž 𝔣 𝔀 ↦cat_Set Ξ± π”Ÿ"
    by (cs_concl cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
  then have dom_rhs: "π’Ÿβˆ˜ ((𝔣 ∘Acat_Set Ξ± ?incl)⦇ArrVal⦈) = vequalizer π”ž 𝔣 𝔀"
    by (cs_concl cs_simp: cat_cs_simps)+

  show ?thesis
  proof(rule arr_Set_eqI)
    from 𝔀_incl show arr_Set_𝔀_incl: "arr_Set Ξ± (𝔀 ∘Acat_Set Ξ± ?incl)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret arr_Set_𝔀_incl: arr_Set Ξ± ‹𝔀 ∘Acat_Set Ξ± ?inclβ€Ί
      by (rule arr_Set_𝔀_incl)
    from 𝔣_incl show arr_Set_𝔣_incl: "arr_Set Ξ± (𝔣 ∘Acat_Set Ξ± ?incl)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret arr_Set_𝔣_incl: arr_Set Ξ± ‹𝔣 ∘Acat_Set Ξ± ?inclβ€Ί
      by (rule arr_Set_𝔣_incl)
    show "(𝔀 ∘Acat_Set Ξ± ?incl)⦇ArrVal⦈ = (𝔣 ∘Acat_Set Ξ± ?incl)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ vequalizer π”ž 𝔣 𝔀"
      with assms show 
        "(𝔀 ∘Acat_Set Ξ± ?incl)⦇ArrValβ¦ˆβ¦‡a⦈ = (𝔣 ∘Acat_Set Ξ± ?incl)⦇ArrValβ¦ˆβ¦‡a⦈"
        by
          (
            cs_concl
              cs_simp: vequalizerD(2) cat_Set_cs_simps cat_cs_simps
              cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
          )
    qed auto
  qed (use 𝔀_incl 𝔣_incl in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed



subsectionβ€ΉAuxiliaryβ€Ί


textβ€Ή
This subsection is reserved for insignificant helper lemmas 
and rules that are used in applied formalization elsewhere.
β€Ί

lemma (in 𝒡) cat_Rel_CId_is_cat_Set_arr:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈"
  shows "cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈ : A ↦cat_Set Ξ± A"
proof-
  from assms show ?thesis
    unfolding cat_Rel_components cat_Set_components(6)[symmetric]
    by (cs_concl cs_simp: cat_Set_components(1) cs_intro: cat_cs_intros)
qed

lemma (in 𝒡) cat_Rel_CId_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B' = A"
    and "C' = A"
    and "β„­' = cat_Set Ξ±"
  shows "cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈ : B' ↦ℭ' C'"
  using assms(1) unfolding assms(2-4) by (rule cat_Rel_CId_is_cat_Set_arr)

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_GRPH

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉGRPHβ€Ίβ€Ί
theory CZH_ECAT_GRPH
  imports 
    CZH_ECAT_Small_Category
    CZH_Foundations.CZH_SMC_GRPH
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The methodology for the exposition of β€ΉGRPHβ€Ί as a category is analogous to
the one used in the previous installment of this body of work
for the exposition of β€ΉGRPHβ€Ί as a semicategory.
β€Ί

named_theorems cat_GRPH_simps
named_theorems cat_GRPH_intros



subsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_GRPH :: "V β‡’ V"
  where "cat_GRPH Ξ± =
    [
      set {β„­. digraph Ξ± β„­}, 
      all_dghms Ξ±, 
      (Ξ»π”‰βˆˆβˆ˜all_dghms Ξ±. 𝔉⦇HomDom⦈), 
      (Ξ»π”‰βˆˆβˆ˜all_dghms Ξ±. 𝔉⦇HomCod⦈),
      (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_GRPH Ξ±). π”Šπ”‰β¦‡0⦈ ∘DGHM π”Šπ”‰β¦‡1β„•β¦ˆ),
      (Ξ»β„­βˆˆβˆ˜set {β„­. digraph Ξ± β„­}. dghm_id β„­)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_GRPH_components:
  shows "cat_GRPH α⦇Obj⦈ = set {β„­. digraph Ξ± β„­}"
    and "cat_GRPH α⦇Arr⦈ = all_dghms Ξ±"
    and "cat_GRPH α⦇Dom⦈ = (Ξ»π”‰βˆˆβˆ˜all_dghms Ξ±. 𝔉⦇HomDom⦈)"
    and "cat_GRPH α⦇Cod⦈ = (Ξ»π”‰βˆˆβˆ˜all_dghms Ξ±. 𝔉⦇HomCod⦈)"
    and "cat_GRPH α⦇Comp⦈ =
      (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_GRPH Ξ±). π”Šπ”‰β¦‡0⦈ ∘DGHM π”Šπ”‰β¦‡1β„•β¦ˆ)"
    and "cat_GRPH α⦇CId⦈ = (Ξ»β„­βˆˆβˆ˜set {β„­. digraph Ξ± β„­}. dghm_id β„­)"
  unfolding cat_GRPH_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_GRPH: "cat_smc (cat_GRPH Ξ±) = smc_GRPH Ξ±"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_GRPH Ξ±)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_GRPH Ξ±) = 5β„•"
    unfolding smc_GRPH_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_GRPH Ξ±)) = π’Ÿβˆ˜ (smc_GRPH Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show 
    "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_GRPH Ξ±)) ⟹ cat_smc (cat_GRPH Ξ±)⦇a⦈ = smc_GRPH α⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        unfold cat_smc_def dg_field_simps cat_GRPH_def smc_GRPH_def
      )
      (auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_GRPH_def)

lemmas_with [folded cat_smc_GRPH, unfolded slicing_simps]: 
  ―‹Digraphβ€Ί
  cat_GRPH_ObjI = smc_GRPH_ObjI
  and cat_GRPH_ObjD = smc_GRPH_ObjD
  and cat_GRPH_ObjE = smc_GRPH_ObjE
  and cat_GRPH_Obj_iff[cat_GRPH_simps] = smc_GRPH_Obj_iff  
  and cat_GRPH_Dom_app[cat_GRPH_simps] = smc_GRPH_Dom_app
  and cat_GRPH_Cod_app[cat_GRPH_simps] = smc_GRPH_Cod_app
  and cat_GRPH_is_arrI = smc_GRPH_is_arrI
  and cat_GRPH_is_arrD = smc_GRPH_is_arrD
  and cat_GRPH_is_arrE = smc_GRPH_is_arrE
  and cat_GRPH_is_arr_iff[cat_GRPH_simps] = smc_GRPH_is_arr_iff

lemmas_with [folded cat_smc_GRPH, unfolded slicing_simps, unfolded cat_smc_GRPH]: 
  ―‹Semicategoryβ€Ί
  cat_GRPH_Comp_vdomain = smc_GRPH_Comp_vdomain
  and cat_GRPH_composable_arrs_dg_GRPH = smc_GRPH_composable_arrs_dg_GRPH
  and cat_GRPH_Comp = smc_GRPH_Comp
  and cat_GRPH_Comp_app[cat_GRPH_simps] = smc_GRPH_Comp_app

lemmas_with (in 𝒡) [folded cat_smc_GRPH, unfolded slicing_simps]: 
  ―‹Semicategoryβ€Ί
  cat_GRPH_obj_initialI = smc_GRPH_obj_initialI
  and cat_GRPH_obj_initialD = smc_GRPH_obj_initialD
  and cat_GRPH_obj_initialE = smc_GRPH_obj_initialE
  and cat_GRPH_obj_initial_iff[cat_GRPH_simps] = smc_GRPH_obj_initial_iff
  and cat_GRPH_obj_terminalI = smc_GRPH_obj_terminalI
  and cat_GRPH_obj_terminalE = smc_GRPH_obj_terminalE


subsectionβ€ΉIdentityβ€Ί

lemma cat_GRPH_CId_app[cat_GRPH_simps]: 
  assumes "digraph Ξ± β„­"
  shows "cat_GRPH α⦇CIdβ¦ˆβ¦‡β„­β¦ˆ = dghm_id β„­"
  using assms unfolding cat_GRPH_components by simp

lemma cat_GRPH_CId_vdomain: "π’Ÿβˆ˜ (cat_GRPH α⦇CId⦈) = set {β„­. digraph Ξ± β„­}"
  unfolding cat_GRPH_components by auto

lemma cat_GRPH_CId_vrange: "β„›βˆ˜ (cat_GRPH α⦇CId⦈) βŠ†βˆ˜ all_dghms Ξ±"
proof(rule vsubsetI)
  fix β„Œ assume "β„Œ ∈∘ β„›βˆ˜ (cat_GRPH α⦇CId⦈)"
  then obtain 𝔄 
    where β„Œ_def: "β„Œ = cat_GRPH α⦇CIdβ¦ˆβ¦‡π”„β¦ˆ" and 𝔄: "𝔄 ∈∘ π’Ÿβˆ˜ (cat_GRPH α⦇CId⦈)"
    unfolding cat_GRPH_components by auto
  from 𝔄 have β„Œ_def': "β„Œ = dghm_id 𝔄" 
    unfolding β„Œ_def cat_GRPH_CId_vdomain by (auto simp: cat_GRPH_CId_app)
  from 𝔄 digraph.dg_dghm_id_is_dghm show "β„Œ ∈∘ all_dghms Ξ±" 
    unfolding β„Œ_def' cat_GRPH_CId_vdomain by force
qed



subsectionβ€Ήβ€ΉGRPHβ€Ί is a categoryβ€Ί

lemma (in 𝒡) tiny_category_cat_GRPH: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_category Ξ² (cat_GRPH Ξ±)"
proof(intro tiny_categoryI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "vfsequence (cat_GRPH Ξ±)" unfolding cat_GRPH_def by simp
  show "vcard (cat_GRPH Ξ±) = 6β„•"
    unfolding cat_GRPH_def by (simp add: nat_omega_simps)
  show "cat_GRPH α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ ∘Acat_GRPH Ξ± 𝔉 = 𝔉"
    if "𝔉 : 𝔄 ↦cat_GRPH Ξ± 𝔅" for 𝔉 𝔄 𝔅
    using that
    unfolding cat_GRPH_is_arr_iff
    by (cs_concl cs_simp: dg_cs_simps cat_GRPH_simps cs_intro: dg_cs_intros)
  show "𝔉 ∘Acat_GRPH Ξ± cat_GRPH α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ = 𝔉"
    if "𝔉 : 𝔅 ↦cat_GRPH Ξ± β„­" for 𝔉 𝔅 β„­
    using that
    unfolding cat_GRPH_is_arr_iff
    by (cs_concl cs_simp: dg_cs_simps cat_GRPH_simps cs_intro: dg_cs_intros)
qed
  (
    simp_all add: 
      assms
      cat_smc_GRPH
      cat_GRPH_components
      digraph.dg_dghm_id_is_dghm
      cat_GRPH_is_arr_iff
      tiny_semicategory_smc_GRPH
  )



subsectionβ€ΉIsomorphismβ€Ί

lemma (in 𝒡) cat_GRPH_is_arr_isomorphismI: 
  assumes "𝔉 : 𝔄 ↦↦DG.isoΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦isocat_GRPH Ξ± 𝔅"
proof(intro is_arr_isomorphismI is_inverseI)
  from assms show 𝔉: "𝔉 : 𝔄 ↦cat_GRPH Ξ± 𝔅"
    unfolding cat_GRPH_is_arr_iff by auto
  note iso_thms = is_iso_dghm_is_arr_isomorphism[OF assms]
  from iso_thms(1) show inv_𝔉: "inv_dghm 𝔉 : 𝔅 ↦cat_GRPH Ξ± 𝔄"
    unfolding cat_GRPH_is_arr_iff by auto
  from assms show "𝔉 : 𝔄 ↦cat_GRPH Ξ± 𝔅"
    unfolding cat_GRPH_is_arr_iff by auto
  from assms have 𝔄: "digraph Ξ± 𝔄" and 𝔅: "digraph Ξ± 𝔅" by auto
  show "inv_dghm 𝔉 ∘Acat_GRPH Ξ± 𝔉 = cat_GRPH α⦇CIdβ¦ˆβ¦‡π”„β¦ˆ"
    unfolding cat_GRPH_CId_app[OF 𝔄] cat_GRPH_Comp_app[OF inv_𝔉 𝔉]
    by (rule iso_thms(2))
  show "𝔉 ∘Acat_GRPH Ξ± inv_dghm 𝔉 = cat_GRPH α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ"
    unfolding cat_GRPH_CId_app[OF 𝔅] cat_GRPH_Comp_app[OF 𝔉 inv_𝔉]
    by (rule iso_thms(3))
qed

lemma (in 𝒡) cat_GRPH_is_arr_isomorphismD: 
  assumes "𝔉 : 𝔄 ↦isocat_GRPH Ξ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦DG.isoΞ± 𝔅"
proof-
  from is_arr_isomorphismD[OF assms] have 𝔉: "𝔉 : 𝔄 ↦cat_GRPH Ξ± 𝔅" 
    and "(βˆƒπ”Š. is_inverse (cat_GRPH Ξ±) π”Š 𝔉)"
    by simp_all
  then obtain π”Š where π”Šπ”‰: "is_inverse (cat_GRPH Ξ±) π”Š 𝔉" by clarsimp
  then obtain 𝔄' 𝔅' where π”Š': "π”Š : 𝔅' ↦cat_GRPH Ξ± 𝔄'"
    and 𝔉': "𝔉 : 𝔄' ↦cat_GRPH Ξ± 𝔅'"
    and π”Šπ”‰: "π”Š ∘Acat_GRPH Ξ± 𝔉 = cat_GRPH α⦇CIdβ¦ˆβ¦‡π”„'⦈"
    and π”‰π”Š: "𝔉 ∘Acat_GRPH Ξ± π”Š = cat_GRPH α⦇CIdβ¦ˆβ¦‡π”…'⦈"
    by auto
  from 𝔉 𝔉' have 𝔄': "𝔄' = 𝔄" and 𝔅': "𝔅' = 𝔅" by auto  
  from 𝔉 have 𝔉: "𝔉 : 𝔄 ↦↦DGΞ± 𝔅" unfolding cat_GRPH_is_arr_iff by simp
  then have 𝔄: "digraph Ξ± 𝔄" and 𝔅: "digraph Ξ± 𝔅" by auto
  from π”Š' have "π”Š : 𝔅 ↦↦DGΞ± 𝔄" 
    unfolding 𝔄' 𝔅' cat_GRPH_is_arr_iff by simp
  moreover from π”Šπ”‰ have "π”Š ∘DGHM 𝔉 = dghm_id 𝔄"
    unfolding 𝔄' cat_GRPH_Comp_app[OF π”Š' 𝔉'] cat_GRPH_CId_app[OF 𝔄] by simp
  moreover from π”‰π”Š have "𝔉 ∘DGHM π”Š = dghm_id 𝔅"
    unfolding 𝔅' cat_GRPH_Comp_app[OF 𝔉' π”Š'] cat_GRPH_CId_app[OF 𝔅] by simp
  ultimately show ?thesis using 𝔉 by (elim is_arr_isomorphism_is_iso_dghm)
qed

lemma (in 𝒡) cat_GRPH_is_arr_isomorphismE: 
  assumes "𝔉 : 𝔄 ↦isocat_GRPH Ξ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦DG.isoΞ± 𝔅"
  using assms by (auto dest: cat_GRPH_is_arr_isomorphismD)

lemma (in 𝒡) cat_GRPH_is_arr_isomorphism_iff[cat_GRPH_simps]: 
  "𝔉 : 𝔄 ↦isocat_GRPH Ξ± 𝔅 ⟷ 𝔉 : 𝔄 ↦↦DG.isoΞ± 𝔅"
  using cat_GRPH_is_arr_isomorphismI cat_GRPH_is_arr_isomorphismD by auto



subsectionβ€ΉIsomorphic objectsβ€Ί

lemma (in 𝒡) cat_GRPH_obj_isoI: 
  assumes "𝔄 β‰ˆDGΞ± 𝔅"
  shows "𝔄 β‰ˆobjcat_GRPH Ξ± 𝔅"
proof-
  from iso_digraphD[OF assms] obtain 𝔉 where "𝔉 : 𝔄 ↦↦DG.isoΞ± 𝔅"
    by clarsimp
  from cat_GRPH_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
qed

lemma (in 𝒡) cat_GRPH_obj_isoD: 
  assumes "𝔄 β‰ˆobjcat_GRPH Ξ± 𝔅"
  shows "𝔄 β‰ˆDGΞ± 𝔅"
proof-
  from obj_isoD[OF assms] obtain 𝔉 where "𝔉 : 𝔄 ↦isocat_GRPH Ξ± 𝔅" 
    by clarsimp
  from cat_GRPH_is_arr_isomorphismD[OF this] show ?thesis
    by (rule iso_digraphI)
qed

lemma (in 𝒡) cat_GRPH_obj_isoE: 
  assumes "𝔄 β‰ˆobjcat_GRPH Ξ± 𝔅"
  obtains "𝔄 β‰ˆDGΞ± 𝔅"
  using assms by (auto simp: cat_GRPH_obj_isoD)

lemma (in 𝒡) cat_GRPH_obj_iso_iff: "𝔄 β‰ˆobjcat_GRPH Ξ± 𝔅 ⟷ 𝔄 β‰ˆDGΞ± 𝔅"
  using cat_GRPH_obj_isoI cat_GRPH_obj_isoD by (intro iffI) auto

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_SemiCAT

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉSemiCATβ€Ίβ€Ί
theory CZH_ECAT_SemiCAT
  imports 
    CZH_Foundations.CZH_SMC_SemiCAT
    CZH_ECAT_Small_Category
    CZH_ECAT_Simple
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The methodology for the exposition of β€ΉSemiCATβ€Ί as a category 
is analogous to the one used in the previous installment 
of this body of work for the exposition of β€ΉSemiCATβ€Ί 
as a semicategory.
β€Ί

named_theorems cat_SemiCAT_simps
named_theorems cat_SemiCAT_intros



subsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_SemiCAT :: "V β‡’ V"
  where "cat_SemiCAT Ξ± =
    [
      set {β„­. semicategory Ξ± β„­}, 
      all_smcfs Ξ±, 
      (Ξ»π”‰βˆˆβˆ˜all_smcfs Ξ±. 𝔉⦇HomDom⦈), 
      (Ξ»π”‰βˆˆβˆ˜all_smcfs Ξ±. 𝔉⦇HomCod⦈),
      (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_SemiCAT Ξ±). π”Šπ”‰β¦‡0⦈ ∘SMCF π”Šπ”‰β¦‡1β„•β¦ˆ),
      (Ξ»β„­βˆˆβˆ˜set {β„­. semicategory Ξ± β„­}. smcf_id β„­)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_SemiCAT_components:
  shows "cat_SemiCAT α⦇Obj⦈ = set {β„­. semicategory Ξ± β„­}"
    and "cat_SemiCAT α⦇Arr⦈ = all_smcfs Ξ±"
    and "cat_SemiCAT α⦇Dom⦈ = (Ξ»π”‰βˆˆβˆ˜all_smcfs Ξ±. 𝔉⦇HomDom⦈)"
    and "cat_SemiCAT α⦇Cod⦈ = (Ξ»π”‰βˆˆβˆ˜all_smcfs Ξ±. 𝔉⦇HomCod⦈)"
    and "cat_SemiCAT α⦇Comp⦈ = 
      (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_SemiCAT Ξ±). π”Šπ”‰β¦‡0⦈ ∘SMCF π”Šπ”‰β¦‡1β„•β¦ˆ)"
    and "cat_SemiCAT α⦇CId⦈ = (Ξ»β„­βˆˆβˆ˜set {β„­. semicategory Ξ± β„­}. smcf_id β„­)"
  unfolding cat_SemiCAT_def dg_field_simps 
  by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_SemiCAT: "cat_smc (cat_SemiCAT Ξ±) = smc_SemiCAT Ξ±"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_SemiCAT Ξ±)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_SemiCAT Ξ±) = 5β„•"
    unfolding smc_SemiCAT_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_SemiCAT Ξ±)) = π’Ÿβˆ˜ (smc_SemiCAT Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_SemiCAT Ξ±)) ⟹ 
    cat_smc (cat_SemiCAT Ξ±)⦇a⦈ = smc_SemiCAT α⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        unfold cat_smc_def dg_field_simps cat_SemiCAT_def smc_SemiCAT_def
      )
      (auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_SemiCAT_def)

lemmas_with [folded cat_smc_SemiCAT, unfolded slicing_simps]: 
  ―‹Digraphβ€Ί
  cat_SemiCAT_ObjI = smc_SemiCAT_ObjI
  and cat_SemiCAT_ObjD = smc_SemiCAT_ObjD
  and cat_SemiCAT_ObjE = smc_SemiCAT_ObjE
  and cat_SemiCAT_Obj_iff[cat_SemiCAT_simps] = smc_SemiCAT_Obj_iff  
  and cat_SemiCAT_Dom_app[cat_SemiCAT_simps] = smc_SemiCAT_Dom_app
  and cat_SemiCAT_Cod_app[cat_SemiCAT_simps] = smc_SemiCAT_Cod_app
  and cat_SemiCAT_is_arrI = smc_SemiCAT_is_arrI
  and cat_SemiCAT_is_arrD = smc_SemiCAT_is_arrD
  and cat_SemiCAT_is_arrE = smc_SemiCAT_is_arrE
  and cat_SemiCAT_is_arr_iff[cat_SemiCAT_simps] = smc_SemiCAT_is_arr_iff

lemmas_with [
    folded cat_smc_SemiCAT, unfolded slicing_simps, unfolded cat_smc_SemiCAT
    ]: 
  ―‹Semicategoryβ€Ί
  cat_SemiCAT_Comp_vdomain = smc_SemiCAT_Comp_vdomain
  and cat_SemiCAT_composable_arrs_dg_SemiCAT = 
    smc_SemiCAT_composable_arrs_dg_SemiCAT
  and cat_SemiCAT_Comp = smc_SemiCAT_Comp
  and cat_SemiCAT_Comp_app[cat_SemiCAT_simps] = smc_SemiCAT_Comp_app
  and cat_SemiCAT_Comp_vrange = smc_SemiCAT_Comp_vrange

lemmas_with (in 𝒡) [folded cat_smc_SemiCAT, unfolded slicing_simps]: 
  ―‹Semicategoryβ€Ί
  cat_SemiCAT_obj_initialI = smc_SemiCAT_obj_initialI
  and cat_SemiCAT_obj_initialD = smc_SemiCAT_obj_initialD
  and cat_SemiCAT_obj_initialE = smc_SemiCAT_obj_initialE
  and cat_SemiCAT_obj_initial_iff[cat_SemiCAT_simps] = 
    smc_SemiCAT_obj_initial_iff
  and cat_SemiCAT_obj_terminalI = smc_SemiCAT_obj_terminalI
  and cat_SemiCAT_obj_terminalE = smc_SemiCAT_obj_terminalE



subsectionβ€ΉIdentityβ€Ί

lemma cat_SemiCAT_CId_app[cat_SemiCAT_simps]: 
  assumes "semicategory Ξ± β„­"
  shows "cat_SemiCAT α⦇CIdβ¦ˆβ¦‡β„­β¦ˆ = smcf_id β„­"
  using assms unfolding cat_SemiCAT_components by simp

lemma cat_SemiCAT_CId_vdomain[cat_SemiCAT_simps]: 
  "π’Ÿβˆ˜ (cat_SemiCAT α⦇CId⦈) = set {β„­. semicategory Ξ± β„­}"
  unfolding cat_SemiCAT_components by auto

lemma cat_SemiCAT_CId_vrange: "β„›βˆ˜ (cat_SemiCAT α⦇CId⦈) βŠ†βˆ˜ all_smcfs Ξ±"
proof(rule vsubsetI)
  fix β„Œ assume "β„Œ ∈∘ β„›βˆ˜ (cat_SemiCAT α⦇CId⦈)"
  then obtain 𝔄 
    where β„Œ_def: "β„Œ = cat_SemiCAT α⦇CIdβ¦ˆβ¦‡π”„β¦ˆ" 
      and 𝔄: "𝔄 ∈∘ π’Ÿβˆ˜ (cat_SemiCAT α⦇CId⦈)"
    unfolding cat_SemiCAT_components by auto
  from 𝔄 have β„Œ_def': "β„Œ = smcf_id 𝔄" 
    unfolding β„Œ_def cat_SemiCAT_CId_vdomain by (auto simp: cat_SemiCAT_CId_app)
  from 𝔄 semicategory.smc_smcf_id_is_semifunctor show "β„Œ ∈∘ all_smcfs Ξ±"
    unfolding β„Œ_def' cat_SemiCAT_CId_vdomain by force
qed



subsectionβ€Ήβ€ΉSemiCATβ€Ί is a categoryβ€Ί

lemma (in 𝒡) tiny_category_cat_SemiCAT: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_category Ξ² (cat_SemiCAT Ξ±)"
proof(intro tiny_categoryI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "vfsequence (cat_SemiCAT Ξ±)" unfolding cat_SemiCAT_def by simp
  show "vcard (cat_SemiCAT Ξ±) = 6β„•"
    unfolding cat_SemiCAT_def by (simp add: nat_omega_simps)
  show "cat_SemiCAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ ∘Acat_SemiCAT Ξ± 𝔉 = 𝔉"
    if "𝔉 : 𝔄 ↦cat_SemiCAT Ξ± 𝔅" for 𝔉 𝔄 𝔅
    using that 
    unfolding cat_SemiCAT_is_arr_iff
    by (cs_concl cs_simp: smc_cs_simps cat_SemiCAT_simps cs_intro: smc_cs_intros)
  show "𝔉 ∘Acat_SemiCAT Ξ± cat_SemiCAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ = 𝔉"
    if "𝔉 : 𝔅 ↦cat_SemiCAT Ξ± β„­" for 𝔉 𝔅 β„­
    using that 
    unfolding cat_SemiCAT_is_arr_iff
    by (cs_concl cs_simp: smc_cs_simps cat_SemiCAT_simps cs_intro: smc_cs_intros)
qed 
  (
    simp_all add: 
      assms
      cat_smc_SemiCAT
      cat_SemiCAT_components
      cat_SemiCAT_is_arr_iff
      tiny_semicategory_smc_SemiCAT
      semicategory.smc_smcf_id_is_semifunctor
  )



subsectionβ€ΉIsomorphismβ€Ί

lemma cat_SemiCAT_is_arr_isomorphismI: 
  assumes "𝔉 : 𝔄 ↦↦SMC.isoΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦isocat_SemiCAT Ξ± 𝔅"
proof(intro is_arr_isomorphismI is_inverseI)
  interpret is_iso_semifunctor Ξ± 𝔄 𝔅 𝔉 by (rule assms)
  from assms show 𝔉: "𝔉 : 𝔄 ↦cat_SemiCAT Ξ± 𝔅"
    unfolding cat_SemiCAT_is_arr_iff by auto
  note iso_thms = is_iso_semifunctor_is_arr_isomorphism[OF assms]
  from iso_thms(1) show inv_𝔉: "inv_smcf 𝔉 : 𝔅 ↦cat_SemiCAT Ξ± 𝔄"
    unfolding cat_SemiCAT_is_arr_iff by auto
  from assms show "𝔉 : 𝔄 ↦cat_SemiCAT Ξ± 𝔅"
    unfolding cat_SemiCAT_is_arr_iff by auto
  from assms have 𝔄: "semicategory Ξ± 𝔄" and 𝔅: "semicategory Ξ± 𝔅" by auto
  show "inv_smcf 𝔉 ∘Acat_SemiCAT Ξ± 𝔉 = cat_SemiCAT α⦇CIdβ¦ˆβ¦‡π”„β¦ˆ"
    unfolding cat_SemiCAT_CId_app[OF 𝔄] cat_SemiCAT_Comp_app[OF inv_𝔉 𝔉]
    by (rule iso_thms(2))
  show "𝔉 ∘Acat_SemiCAT Ξ± inv_smcf 𝔉 = cat_SemiCAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ"
    unfolding cat_SemiCAT_CId_app[OF 𝔅] cat_SemiCAT_Comp_app[OF 𝔉 inv_𝔉]
    by (rule iso_thms(3))
qed

lemma cat_SemiCAT_is_arr_isomorphismD: 
  assumes "𝔉 : 𝔄 ↦isocat_SemiCAT Ξ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦SMC.isoΞ± 𝔅"
proof-
  from is_arr_isomorphismD[OF assms] have 𝔉: "𝔉 : 𝔄 ↦cat_SemiCAT Ξ± 𝔅" 
    and "(βˆƒπ”Š. is_inverse (cat_SemiCAT Ξ±) π”Š 𝔉)"
    by simp_all
  then obtain π”Š where π”Šπ”‰: "is_inverse (cat_SemiCAT Ξ±) π”Š 𝔉" by clarsimp
  then obtain 𝔄' 𝔅' where π”Š': "π”Š : 𝔅' ↦cat_SemiCAT Ξ± 𝔄'"
    and 𝔉': "𝔉 : 𝔄' ↦cat_SemiCAT Ξ± 𝔅'"
    and π”Šπ”‰: "π”Š ∘Acat_SemiCAT Ξ± 𝔉 = cat_SemiCAT α⦇CIdβ¦ˆβ¦‡π”„'⦈"
    and π”‰π”Š: "𝔉 ∘Acat_SemiCAT Ξ± π”Š = cat_SemiCAT α⦇CIdβ¦ˆβ¦‡π”…'⦈"
    by auto
  from 𝔉 𝔉' have 𝔄': "𝔄' = 𝔄" and 𝔅': "𝔅' = 𝔅" by auto  
  from 𝔉 have 𝔉: "𝔉 : 𝔄 ↦↦SMCΞ± 𝔅" unfolding cat_SemiCAT_is_arr_iff by simp
  interpret is_semifunctor Ξ± 𝔄 𝔅 𝔉 by (rule 𝔉)
  have 𝔄: "semicategory Ξ± 𝔄" and 𝔅: "semicategory Ξ± 𝔅" 
    by (cs_concl cs_intro: smc_cs_intros)+
  from π”Š' have π”Š: "π”Š : 𝔅 ↦↦SMCΞ± 𝔄" 
    unfolding 𝔄' 𝔅' cat_SemiCAT_is_arr_iff by simp
  moreover from π”Šπ”‰ have "π”Š ∘SMCF 𝔉 = smcf_id 𝔄"
    unfolding 𝔄' cat_SemiCAT_Comp_app[OF π”Š' 𝔉'] cat_SemiCAT_CId_app[OF 𝔄] 
    by simp
  moreover from π”‰π”Š have "𝔉 ∘SMCF π”Š = smcf_id 𝔅"
    unfolding 𝔅' cat_SemiCAT_Comp_app[OF 𝔉' π”Š'] cat_SemiCAT_CId_app[OF 𝔅] 
    by simp
  ultimately show ?thesis 
    using 𝔉 by (elim is_arr_isomorphism_is_iso_semifunctor)
qed

lemma cat_SemiCAT_is_arr_isomorphismE: 
  assumes "𝔉 : 𝔄 ↦isocat_SemiCAT Ξ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦SMC.isoΞ± 𝔅"
  using assms by (auto dest: cat_SemiCAT_is_arr_isomorphismD)

lemma cat_SemiCAT_is_arr_isomorphism_iff[cat_SemiCAT_simps]: 
  "𝔉 : 𝔄 ↦isocat_SemiCAT Ξ± 𝔅 ⟷ 𝔉 : 𝔄 ↦↦SMC.isoΞ± 𝔅"
  using cat_SemiCAT_is_arr_isomorphismI cat_SemiCAT_is_arr_isomorphismD by auto



subsectionβ€ΉIsomorphic objectsβ€Ί

lemma cat_SemiCAT_obj_isoI: 
  assumes "𝔄 β‰ˆSMCΞ± 𝔅"
  shows "𝔄 β‰ˆobjcat_SemiCAT Ξ± 𝔅"
proof-
  from iso_semicategoryD[OF assms] obtain 𝔉 where "𝔉 : 𝔄 ↦↦SMC.isoΞ± 𝔅"
    by clarsimp
  from cat_SemiCAT_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
qed

lemma cat_SemiCAT_obj_isoD: 
  assumes "𝔄 β‰ˆobjcat_SemiCAT Ξ± 𝔅"
  shows "𝔄 β‰ˆSMCΞ± 𝔅"
proof-
  from obj_isoD[OF assms] obtain 𝔉 where "𝔉 : 𝔄 ↦isocat_SemiCAT Ξ± 𝔅" 
    by clarsimp
  from cat_SemiCAT_is_arr_isomorphismD[OF this] show ?thesis
    by (rule iso_semicategoryI)
qed

lemma cat_SemiCAT_obj_isoE: 
  assumes "𝔄 β‰ˆobjcat_SemiCAT Ξ± 𝔅"
  obtains "𝔄 β‰ˆSMCΞ± 𝔅"
  using assms by (auto simp: cat_SemiCAT_obj_isoD)

lemma cat_SemiCAT_obj_iso_iff[cat_SemiCAT_simps]: 
  "𝔄 β‰ˆobjcat_SemiCAT Ξ± 𝔅 ⟷ 𝔄 β‰ˆSMCΞ± 𝔅"
  using cat_SemiCAT_obj_isoI cat_SemiCAT_obj_isoD by (intro iffI) auto

textβ€Ή\newpageβ€Ί

end

Theory CZH_DG_CAT

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉCATβ€Ί as a digraph\label{sec:dg_CAT}β€Ί
theory CZH_DG_CAT
  imports 
    CZH_ECAT_Functor
    CZH_ECAT_Small_Category
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
β€ΉCATβ€Ί is usually defined as a category of categories and functors
(e.g., see Chapter I-2 in \cite{mac_lane_categories_2010}).
However, there is little that can prevent one from exposing β€ΉCATβ€Ί
as a digraph and provide additional structure gradually in
subsequent theories. 
Thus, in this section, β€ΉΞ±β€Ί-β€ΉCATβ€Ί is defined as a digraph of categories 
and functors in the set β€ΉVΞ±β€Ί, and β€ΉΞ±β€Ί-β€ΉCatβ€Ί is defined
as a digraph of tiny categories and tiny functors in β€ΉVΞ±β€Ί.
β€Ί

named_theorems dg_CAT_simps
named_theorems dg_CAT_intros



subsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition dg_CAT :: "V β‡’ V"
  where "dg_CAT Ξ± =
    [
      set {β„­. category Ξ± β„­}, 
      all_cfs Ξ±, 
      (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomDom⦈), 
      (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomCod⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma dg_CAT_components:
  shows "dg_CAT α⦇Obj⦈ = set {β„­. category Ξ± β„­}"
    and "dg_CAT α⦇Arr⦈ = all_cfs Ξ±"
    and "dg_CAT α⦇Dom⦈ = (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomDom⦈)"
    and "dg_CAT α⦇Cod⦈ = (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomCod⦈)"
  unfolding dg_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)



subsectionβ€ΉObjectβ€Ί

lemma dg_CAT_ObjI:
  assumes "category Ξ± 𝔄"
  shows "𝔄 ∈∘ dg_CAT α⦇Obj⦈"
  using assms unfolding dg_CAT_components by auto

lemma dg_CAT_ObjD:
  assumes "𝔄 ∈∘ dg_CAT α⦇Obj⦈"
  shows "category Ξ± 𝔄"
  using assms unfolding dg_CAT_components by auto

lemma dg_CAT_ObjE:
  assumes "𝔄 ∈∘ dg_CAT α⦇Obj⦈"
  obtains "category Ξ± 𝔄"
  using assms unfolding dg_CAT_components by auto

lemma dg_CAT_Obj_iff[dg_CAT_simps]: "𝔄 ∈∘ dg_CAT α⦇Obj⦈ ⟷ category Ξ± 𝔄"
  unfolding dg_CAT_components by auto



subsectionβ€ΉDomain and codomainβ€Ί

lemma [dg_CAT_simps]:
  assumes "𝔉 ∈∘ all_cfs Ξ±"  
  shows dg_CAT_Dom_app: "dg_CAT α⦇Domβ¦ˆβ¦‡π”‰β¦ˆ = 𝔉⦇HomDom⦈"
    and dg_CAT_Cod_app: "dg_CAT α⦇Codβ¦ˆβ¦‡π”‰β¦ˆ = 𝔉⦇HomCod⦈"
  using assms unfolding dg_CAT_components by auto



subsectionβ€Ήβ€ΉCATβ€Ί is a digraphβ€Ί

lemma (in 𝒡) tiny_category_dg_CAT: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_digraph Ξ² (dg_CAT Ξ±)"
proof(intro tiny_digraphI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "vfsequence (dg_CAT Ξ±)" unfolding dg_CAT_def by simp
  show "vcard (dg_CAT Ξ±) = 4β„•"
    unfolding dg_CAT_def by (simp add: nat_omega_simps)
  show "β„›βˆ˜ (dg_CAT α⦇Dom⦈) βŠ†βˆ˜ dg_CAT α⦇Obj⦈" 
  proof(intro vsubsetI)
    fix 𝔄 assume "𝔄 ∈∘ β„›βˆ˜ (dg_CAT α⦇Dom⦈)"
    then obtain 𝔉 where "𝔉 ∈∘ all_cfs Ξ±" and "𝔄 = 𝔉⦇HomDom⦈"
      unfolding dg_CAT_components by auto
    then obtain 𝔅 𝔉 where "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
      unfolding dg_CAT_components by auto
    then interpret is_functor Ξ± 𝔄 𝔅 𝔉 by simp
    show "𝔄 ∈∘ dg_CAT α⦇Obj⦈"
      by (simp add: dg_CAT_components HomDom.category_axioms)
  qed
  show "β„›βˆ˜ (dg_CAT α⦇Cod⦈) βŠ†βˆ˜ dg_CAT α⦇Obj⦈"
  proof(intro vsubsetI)
    fix 𝔅 assume "𝔅 ∈∘ β„›βˆ˜ (dg_CAT α⦇Cod⦈)"
    then obtain 𝔉 where "𝔉 ∈∘ π’Ÿβˆ˜ (dg_CAT α⦇Cod⦈)" and "𝔅 = 𝔉⦇HomCod⦈"
      unfolding dg_CAT_components by auto
    then obtain 𝔄 𝔉 
      where dghm: "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and 𝔅_def: "𝔅 = 𝔉⦇HomCod⦈"
      unfolding dg_CAT_components by auto
    have "𝔅 = 𝔉⦇HomCod⦈" unfolding 𝔅_def by simp
    interpret is_functor Ξ± 𝔄 𝔅 𝔉 by (rule dghm)
    show "𝔅 ∈∘ dg_CAT α⦇Obj⦈"
      by (simp add: HomCod.category_axioms dg_CAT_components)
  qed
  show "dg_CAT α⦇Obj⦈ ∈∘ Vset Ξ²"
    unfolding dg_CAT_components by (rule categories_in_Vset[OF assms])
  show "dg_CAT α⦇Arr⦈ ∈∘ Vset Ξ²"
    unfolding dg_CAT_components by (rule all_cfs_in_Vset[OF assms])
qed (simp_all add: assms dg_CAT_components)



subsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma dg_CAT_is_arrI:
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
  shows "𝔉 : 𝔄 ↦dg_CAT Ξ± 𝔅"
proof(intro is_arrI, unfold dg_CAT_components(2))
  interpret is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms)
  from assms show "𝔉 ∈∘ all_cfs Ξ±" by auto
  with assms show "dg_CAT α⦇Domβ¦ˆβ¦‡π”‰β¦ˆ = 𝔄" "dg_CAT α⦇Codβ¦ˆβ¦‡π”‰β¦ˆ = 𝔅"
    by (simp_all add: dg_CAT_components cat_cs_simps)
qed 

lemma dg_CAT_is_arrD:
  assumes "𝔉 : 𝔄 ↦dg_CAT Ξ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
  using assms by (elim is_arrE) (auto simp: dg_CAT_components)

lemma dg_CAT_is_arrE:
  assumes "𝔉 : 𝔄 ↦dg_CAT Ξ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  using assms by (simp add: dg_CAT_is_arrD)

lemma dg_CAT_is_arr_iff[dg_CAT_simps]: 
  "𝔉 : 𝔄 ↦dg_CAT Ξ± 𝔅 ⟷ 𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
  by (auto intro: dg_CAT_is_arrI dest: dg_CAT_is_arrD)

textβ€Ή\newpageβ€Ί

end

Theory CZH_SMC_CAT

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉCATβ€Ί as a semicategory\label{sec:smc_CAT}β€Ί
theory CZH_SMC_CAT
  imports 
    CZH_DG_CAT
    CZH_ECAT_Simple
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The subsection presents the theory of the semicategories of β€ΉΞ±β€Ί-categories.
It continues the development that was initiated in section 
\ref{sec:dg_CAT}.
β€Ί

named_theorems smc_CAT_simps
named_theorems smc_CAT_intros



subsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition smc_CAT :: "V β‡’ V"
  where "smc_CAT Ξ± =
    [
      set {β„­. category Ξ± β„­}, 
      all_cfs Ξ±, 
      (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomDom⦈), 
      (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomCod⦈),
      (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_CAT Ξ±). π”Šπ”‰β¦‡0⦈ ∘CF π”Šπ”‰β¦‡1β„•β¦ˆ)
    ]∘"


textβ€ΉComponents.β€Ί

lemma smc_CAT_components:
  shows "smc_CAT α⦇Obj⦈ = set {β„­. category Ξ± β„­}"
    and "smc_CAT α⦇Arr⦈ = all_cfs Ξ±"
    and "smc_CAT α⦇Dom⦈ = (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomDom⦈)"
    and "smc_CAT α⦇Cod⦈ = (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomCod⦈)"
    and "smc_CAT α⦇Comp⦈ = (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_CAT Ξ±). π”Šπ”‰β¦‡0⦈ ∘CF π”Šπ”‰β¦‡1β„•β¦ˆ)"
  unfolding smc_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma smc_dg_CAT: "smc_dg (smc_CAT Ξ±) = dg_CAT Ξ±"
proof(rule vsv_eqI)
  show "vsv (smc_dg (smc_CAT Ξ±))" unfolding smc_dg_def by auto
  show "vsv (dg_CAT Ξ±)" unfolding dg_CAT_def by auto
  have dom_lhs: "π’Ÿβˆ˜ (smc_dg (smc_CAT Ξ±)) = 4β„•" 
    unfolding smc_dg_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (dg_CAT Ξ±) = 4β„•"
    unfolding dg_CAT_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (smc_dg (smc_CAT Ξ±)) = π’Ÿβˆ˜ (dg_CAT Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show "𝔄 ∈∘ π’Ÿβˆ˜ (smc_dg (smc_CAT Ξ±)) ⟹ smc_dg (smc_CAT Ξ±)β¦‡π”„β¦ˆ = dg_CAT Ξ±β¦‡π”„β¦ˆ"
    for 𝔄
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral,
        unfold smc_dg_def dg_field_simps smc_CAT_def dg_CAT_def
      )
      (auto simp: nat_omega_simps)
qed

lemmas_with [folded smc_dg_CAT, unfolded slicing_simps]: 
  smc_CAT_ObjI = dg_CAT_ObjI
  and smc_CAT_ObjD = dg_CAT_ObjD
  and smc_CAT_ObjE = dg_CAT_ObjE
  and smc_CAT_Obj_iff[smc_CAT_simps] = dg_CAT_Obj_iff  
  and smc_CAT_Dom_app[smc_CAT_simps] = dg_CAT_Dom_app
  and smc_CAT_Cod_app[smc_CAT_simps] = dg_CAT_Cod_app
  and smc_CAT_is_arrI = dg_CAT_is_arrI
  and smc_CAT_is_arrD = dg_CAT_is_arrD
  and smc_CAT_is_arrE = dg_CAT_is_arrE
  and smc_CAT_is_arr_iff[smc_CAT_simps] = dg_CAT_is_arr_iff


subsectionβ€ΉComposable arrowsβ€Ί

lemma smc_CAT_composable_arrs_dg_CAT: 
  "composable_arrs (dg_CAT Ξ±) = composable_arrs (smc_CAT Ξ±)"
  unfolding composable_arrs_def smc_dg_CAT[symmetric] slicing_simps by auto

lemma smc_CAT_Comp: 
  "smc_CAT α⦇Comp⦈ = (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (smc_CAT Ξ±). π”Šπ”‰β¦‡0⦈ ∘SMCF π”Šπ”‰β¦‡1β„•β¦ˆ)"
  unfolding smc_CAT_components smc_CAT_composable_arrs_dg_CAT ..



subsectionβ€ΉCompositionβ€Ί

lemma smc_CAT_Comp_app[smc_CAT_simps]:
  assumes "π”Š : 𝔅 ↦smc_CAT Ξ± β„­" and "𝔉 : 𝔄 ↦smc_CAT Ξ± 𝔅"
  shows "π”Š ∘Asmc_CAT Ξ± 𝔉 = π”Š ∘SMCF 𝔉"
proof-
  from assms have "[π”Š, 𝔉]∘ ∈∘ composable_arrs (smc_CAT Ξ±)" 
    by (auto simp: smc_cs_intros)
  then show "π”Š ∘Asmc_CAT Ξ± 𝔉 = π”Š ∘SMCF 𝔉"
    unfolding smc_CAT_Comp by (simp add: nat_omega_simps)
qed 

lemma smc_CAT_Comp_vdomain: "π’Ÿβˆ˜ (smc_CAT α⦇Comp⦈) = composable_arrs (smc_CAT Ξ±)" 
  unfolding smc_CAT_Comp by auto                      

lemma smc_CAT_Comp_vrange: "β„›βˆ˜ (smc_CAT α⦇Comp⦈) βŠ†βˆ˜ all_cfs Ξ±"
proof(rule vsubsetI)
  fix β„Œ assume "β„Œ ∈∘ β„›βˆ˜ (smc_CAT α⦇Comp⦈)"
  then obtain π”Šπ”‰ 
    where β„Œ_def: "β„Œ = smc_CAT α⦇Compβ¦ˆβ¦‡π”Šπ”‰β¦ˆ"
      and "π”Šπ”‰ ∈∘ π’Ÿβˆ˜ (smc_CAT α⦇Comp⦈)"
    by (auto simp: smc_CAT_components intro: smc_cs_intros)
  then obtain π”Š 𝔉 𝔄 𝔅 β„­ 
    where "π”Šπ”‰ = [π”Š, 𝔉]∘" 
      and π”Š: "π”Š : 𝔅 ↦smc_CAT Ξ± β„­" 
      and 𝔉: "𝔉 : 𝔄 ↦smc_CAT Ξ± 𝔅"
    by (auto simp: smc_CAT_Comp_vdomain) 
  with β„Œ_def have β„Œ_def': "β„Œ = π”Š ∘Asmc_CAT Ξ± 𝔉" by simp
  from π”Š 𝔉 show "β„Œ ∈∘ all_cfs Ξ±" 
    unfolding β„Œ_def' by (auto simp: smc_CAT_simps intro: cat_cs_intros)
qed



subsectionβ€Ήβ€ΉCATβ€Ί is a categoryβ€Ί

lemma (in 𝒡) tiny_semicategory_smc_CAT: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_semicategory Ξ² (smc_CAT Ξ±)"
proof(intro tiny_semicategoryI, unfold smc_CAT_is_arr_iff)
  show "vfsequence (smc_CAT Ξ±)" unfolding smc_CAT_def by auto
  show "vcard (smc_CAT Ξ±) = 5β„•"
    unfolding smc_CAT_def by (simp add: nat_omega_simps)
  show "(π”Šπ”‰ ∈∘ π’Ÿβˆ˜ (smc_CAT α⦇Comp⦈)) ⟷
    (βˆƒπ”Š 𝔉 𝔅 β„­ 𝔄. π”Šπ”‰ = [π”Š, 𝔉]∘ ∧ π”Š : 𝔅 ↦↦CΞ± β„­ ∧ 𝔉 : 𝔄 ↦↦CΞ± 𝔅)"
    for π”Šπ”‰
    unfolding smc_CAT_Comp_vdomain
  proof
    show "π”Šπ”‰ ∈∘ composable_arrs (smc_CAT Ξ±) ⟹ 
      βˆƒπ”Š 𝔉 𝔅 β„­ 𝔄. π”Šπ”‰ = [π”Š, 𝔉]∘ ∧ π”Š : 𝔅 ↦↦CΞ± β„­ ∧ 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
      by (elim composable_arrsE) (auto simp: smc_CAT_is_arr_iff)
  next
    assume "βˆƒπ”Š 𝔉 𝔅 β„­ 𝔄. π”Šπ”‰ = [π”Š, 𝔉]∘ ∧ π”Š : 𝔅 ↦↦CΞ± β„­ ∧ 𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    with smc_CAT_is_arr_iff show "π”Šπ”‰ ∈∘ composable_arrs (smc_CAT Ξ±)"
      unfolding smc_CAT_Comp_vdomain by (auto intro: smc_cs_intros)
  qed
  show "⟦ π”Š : 𝔅 ↦↦CΞ± β„­; 𝔉 : 𝔄 ↦↦CΞ± 𝔅 ⟧ ⟹ 
    π”Š ∘Asmc_CAT Ξ± 𝔉 : 𝔄 ↦↦CΞ± β„­"
    for π”Š 𝔅 β„­ 𝔉 𝔄
    by (cs_concl cs_simp: smc_CAT_simps cs_intro: cat_cs_intros)

  fix β„Œ β„­ 𝔇 π”Š 𝔅 𝔉 𝔄
  assume "β„Œ : β„­ ↦↦CΞ± 𝔇" "π”Š : 𝔅 ↦↦CΞ± β„­" "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  moreover then have "π”Š ∘CF 𝔉 : 𝔄 ↦↦CΞ± β„­" "β„Œ ∘CF π”Š : 𝔅 ↦↦CΞ± 𝔇" 
    by (cs_concl cs_simp: smc_CAT_simps cs_intro: cat_cs_intros)+
  ultimately show 
    "β„Œ ∘Asmc_CAT Ξ± π”Š ∘Asmc_CAT Ξ± 𝔉 = β„Œ ∘Asmc_CAT Ξ± (π”Š ∘Asmc_CAT Ξ± 𝔉)"
    by (simp add: smc_CAT_is_arr_iff smc_CAT_Comp_app cf_comp_assoc)
qed (auto simp: assms smc_dg_CAT tiny_category_dg_CAT smc_CAT_components)



subsectionβ€ΉInitial objectβ€Ί

lemma (in 𝒡) smc_CAT_obj_initialI: "obj_initial (smc_CAT Ξ±) cat_0"
  ―‹
  See \cite{noauthor_nlab_nodate}\footnote{\url{
  https://ncatlab.org/nlab/show/initial+object
  }}).
  β€Ί
  unfolding obj_initial_def
proof(intro obj_terminalI, unfold smc_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)
  show "category Ξ± cat_0" by (intro category_cat_0)
  fix 𝔄 assume "category Ξ± 𝔄"
  then interpret category Ξ± 𝔄 .
  show "βˆƒ!f. f : cat_0 ↦↦CΞ± 𝔄"
  proof
    show cf_0: "cf_0 𝔄 : cat_0 ↦↦CΞ± 𝔄"
      by (simp add: cf_0_is_functor category_axioms is_ft_functor.axioms(1))
    fix 𝔉 assume prems: "𝔉 : cat_0 ↦↦CΞ± 𝔄" 
    interpret 𝔉: is_functor Ξ± cat_0 𝔄 𝔉 using prems .
    show "𝔉 = cf_0 𝔄"
    proof(rule cf_eqI)
      show "𝔉 : cat_0 ↦↦CΞ± 𝔄" by (simp add: prems)
      from cf_0 show "cf_0 𝔄 : cat_0 ↦↦CΞ± 𝔄" 
        unfolding smc_CAT_is_arr_iff by simp
      have "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = 0" by (auto simp: cat_0_components cat_cs_simps)
      then show "𝔉⦇ObjMap⦈ = cf_0 𝔄⦇ObjMap⦈"
        using 𝔉.ObjMap.vbrelation_vintersection_vdomain 
        by (auto simp: cf_0_components)
      have "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = 0" by (auto simp: cat_0_components cat_cs_simps)
      with 𝔉.ArrMap.vbrelation_vintersection_vdomain show 
        "𝔉⦇ArrMap⦈ = cf_0 𝔄⦇ArrMap⦈"
        by (auto simp: cf_0_components)
    qed (simp_all add: cf_0_components)
  qed
qed

lemma (in 𝒡) smc_CAT_obj_initialD:
  assumes "obj_initial (smc_CAT Ξ±) 𝔄"
  shows "𝔄 = cat_0" 
  using assms unfolding obj_initial_def
proof(elim obj_terminalE, unfold smc_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)
  assume prems: 
    "category Ξ± 𝔄" 
    "category Ξ± 𝔅 ⟹ βˆƒ!𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
    for 𝔅
  from prems(2)[OF category_cat_0] obtain 𝔉 where 𝔉: "𝔉 : 𝔄 ↦↦CΞ± cat_0" 
    by meson
  interpret 𝔉: is_functor Ξ± 𝔄 cat_0 𝔉 by (rule 𝔉) 
  have "β„›βˆ˜ (𝔉⦇ObjMap⦈) βŠ†βˆ˜ 0"
    unfolding cat_0_components(1)[symmetric] by (simp add: 𝔉.cf_ObjMap_vrange)
  then have "𝔉⦇ObjMap⦈ = 0" by (auto intro: 𝔉.ObjMap.vsv_vrange_vempty)
  with 𝔉.cf_ObjMap_vdomain have Obj[simp]: "𝔄⦇Obj⦈ = 0" by auto
  have "β„›βˆ˜ (𝔉⦇ArrMap⦈) βŠ†βˆ˜ 0"
    unfolding cat_0_components(2)[symmetric] by (simp add: 𝔉.cf_ArrMap_vrange)
  then have "𝔉⦇ArrMap⦈ = 0" by (auto intro: 𝔉.ArrMap.vsv_vrange_vempty)
  with 𝔉.cf_ArrMap_vdomain have Arr[simp]: "𝔄⦇Arr⦈ = 0" by auto
  from 𝔉.HomDom.Dom.vdomain_vrange_is_vempty have [simp]: "𝔄⦇Dom⦈ = 0"  
    by (fastforce simp: 𝔉.HomDom.cat_Dom_vempty_if_Arr_vempty)
  from 𝔉.HomDom.Cod.vdomain_vrange_is_vempty have [simp]: "𝔄⦇Cod⦈ = 0"
    by (fastforce simp: 𝔉.HomDom.cat_Cod_vempty_if_Arr_vempty)
  from Arr have "𝔄⦇Arr⦈ ^Γ— 2β„• = 0" by (simp add: vcpower_of_vempty)
  with 𝔉.HomDom.Comp.pnop_vdomain have "π’Ÿβˆ˜ (𝔄⦇Comp⦈) = 0" by simp
  with 𝔉.HomDom.Comp.vdomain_vrange_is_vempty have [simp]: "𝔄⦇Comp⦈ = 0"
    by (auto intro: 𝔉.HomDom.Comp.vsv_vrange_vempty)
  have "π’Ÿβˆ˜ (𝔄⦇CId⦈) = 0"
    by (simp add: 𝔉.HomDom.cat_CId_vdomain)
  with 𝔉.HomDom.CId.vdomain_vrange_is_vempty 𝔉.HomDom.CId.vsv_vrange_vempty 
  have [simp]: "𝔄⦇CId⦈ = 0"
    by simp
  show "𝔄 = cat_0"
    by (rule cat_eqI[of Ξ±])  
      (simp_all add: prems(1) cat_0_components category_cat_0)
qed

lemma (in 𝒡) smc_CAT_obj_initialE:
  assumes "obj_initial (smc_CAT Ξ±) 𝔄"
  obtains "𝔄 = cat_0" 
  using assms by (auto dest: smc_CAT_obj_initialD)

lemma (in 𝒡) smc_CAT_obj_initial_iff[smc_CAT_simps]: 
  "obj_initial (smc_CAT Ξ±) 𝔄 ⟷ 𝔄 = cat_0"
  using smc_CAT_obj_initialI smc_CAT_obj_initialD by auto



subsectionβ€ΉTerminal objectβ€Ί

lemma (in 𝒡) smc_CAT_obj_terminalI: 
  ―‹See \cite{noauthor_nlab_nodate}\footnote{\url{
  https://ncatlab.org/nlab/show/terminal+object
  }}.β€Ί
  assumes "a ∈∘ Vset α" and "f ∈∘ Vset α"
  shows "obj_terminal (smc_CAT Ξ±) (cat_1 a f)"
proof(intro obj_terminalI, unfold smc_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)
  fix 𝔄 assume prems: "category Ξ± 𝔄"
  then interpret category Ξ± 𝔄 .
  show "βˆƒ!𝔉'. 𝔉' : 𝔄 ↦↦CΞ± cat_1 a f"
  proof
    show cf_1: "cf_const 𝔄 (cat_1 a f) a : 𝔄 ↦↦CΞ± cat_1 a f"
      by (rule cf_const_is_functor)
        (auto simp: assms prems category_cat_1 cat_1_components)
    fix 𝔉' assume "𝔉' : 𝔄 ↦↦CΞ± cat_1 a f"
    then interpret 𝔉': is_functor Ξ± 𝔄 β€Ήcat_1 a fβ€Ί 𝔉' .
    show "𝔉' = cf_const 𝔄 (cat_1 a f) a"
    proof(rule cf_eqI, unfold dghm_const_components)
      from cf_1 show "cf_const 𝔄 (cat_1 a f) a : 𝔄 ↦↦CΞ± cat_1 a f" by simp
      show "𝔉'⦇ObjMap⦈ = vconst_on (𝔄⦇Obj⦈) a"
      proof(cases‹𝔄⦇Obj⦈ = 0β€Ί)
        case True
        with 𝔉'.ObjMap.vbrelation_vintersection_vdomain have "𝔉'⦇ObjMap⦈ = 0"
          by (auto simp: cat_cs_simps)
        with True show ?thesis by simp
      next
        case False
        then have "π’Ÿβˆ˜ (𝔉'⦇ObjMap⦈) β‰  0" by (auto simp: cat_cs_simps)
        then have "β„›βˆ˜ (𝔉'⦇ObjMap⦈) β‰  0"
          by (simp add: 𝔉'.ObjMap.vsv_vdomain_vempty_vrange_vempty)
        moreover from 𝔉'.cf_ObjMap_vrange have "β„›βˆ˜ (𝔉'⦇ObjMap⦈) βŠ†βˆ˜ set {a}"
          by (simp add: cat_1_components)
        ultimately have "β„›βˆ˜ (𝔉'⦇ObjMap⦈) = set {a}" by auto
        then show ?thesis 
          by (intro vsv.vsv_is_vconst_onI) (auto simp: cat_cs_simps) 
      qed
      show "𝔉'⦇ArrMap⦈ = vconst_on (𝔄⦇Arr⦈) (cat_1 a f⦇CIdβ¦ˆβ¦‡a⦈)"
      proof(cases‹𝔄⦇Arr⦈ = 0β€Ί)
        case True
        with 
          𝔉'.ArrMap.vdomain_vrange_is_vempty
          vsv.vsv_vrange_vempty[OF 𝔉'.cf_ArrMap_vsv] 
        have "𝔉'⦇ArrMap⦈ = 0"
          by (auto simp: cat_cs_simps)
        with True show ?thesis by simp
      next
        case False
        then have "π’Ÿβˆ˜ (𝔉'⦇ArrMap⦈) β‰  0" by (auto simp: cat_cs_simps)
        then have "β„›βˆ˜ (𝔉'⦇ArrMap⦈) β‰  0" 
          by (simp add: 𝔉'.ArrMap.vsv_vdomain_vempty_vrange_vempty)
        moreover from 𝔉'.cf_ArrMap_vrange have "β„›βˆ˜ (𝔉'⦇ArrMap⦈) βŠ†βˆ˜ set {f}"
          by (simp add: cat_1_components)
        ultimately have "β„›βˆ˜ (𝔉'⦇ArrMap⦈) = set {f}" by auto
        then show ?thesis 
          by 
            (
              cs_concl 
                cs_simp: V_cs_simps cat_cs_simps cat_1_components
                cs_intro: V_cs_intros vsv.vsv_is_vconst_onI
            )+
      qed
    qed (auto intro: cat_cs_intros)
  qed 
qed (simp add: assms category_cat_1)

lemma (in 𝒡) smc_CAT_obj_terminalE: 
  assumes "obj_terminal (smc_CAT Ξ±) 𝔅"
  obtains a f where "a ∈∘ Vset Ξ±" and "f ∈∘ Vset Ξ±" and "𝔅 = cat_1 a f"
  using assms
proof(elim obj_terminalE, unfold cat_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)

  assume prems: "category Ξ± 𝔅" "category Ξ± 𝔄 ⟹ βˆƒ!𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅" for 𝔄
  interpret 𝔅: category Ξ± 𝔅 by (rule prems(1))

  obtain a where 𝔅_Obj: "𝔅⦇Obj⦈ = set {a}" and a: "a ∈∘ Vset Ξ±"
  proof-
    have cat_1: "category Ξ± (cat_1 0 0)" by (rule category_cat_1) auto
    from prems(2)[OF cat_1] obtain 𝔉 
      where 𝔉: "𝔉 : cat_1 0 0 ↦↦CΞ± 𝔅" 
        and π”Šπ”‰: "π”Š : cat_1 0 0 ↦↦CΞ± 𝔅 ⟹ π”Š = 𝔉" for π”Š
      by fastforce
    interpret 𝔉: is_functor Ξ± β€Ήcat_1 0 0β€Ί 𝔅 𝔉 by (rule 𝔉)
    have "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = set {0}" by (simp add: cat_1_components cat_cs_simps)
    then obtain a where vrange_𝔉[simp]: "β„›βˆ˜ (𝔉⦇ObjMap⦈) = set {a}"
      by (auto intro: 𝔉.ObjMap.vsv_vdomain_vsingleton_vrange_vsingleton)
    with 𝔅.cat_Obj_vsubset_Vset 𝔉.cf_ObjMap_vrange have [simp]: "a ∈∘ Vset Ξ±"
      by auto
    from 𝔉.cf_ObjMap_vrange have "set {a} βŠ†βˆ˜ 𝔅⦇Obj⦈" by simp
    moreover have "𝔅⦇Obj⦈ βŠ†βˆ˜ set {a}"
    proof(rule ccontr)
      assume "¬𝔅⦇Obj⦈ βŠ†βˆ˜ set {a}"
      then obtain b where ba: "b β‰  a" and b: "b ∈∘ 𝔅⦇Obj⦈" by force
      have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦CΞ± 𝔅"
        by (rule cf_const_is_functor)
          (simp_all add: 𝔅.category_axioms category_cat_1 b)
      then have π”Š_def: "cf_const (cat_1 0 0) 𝔅 b = 𝔉" by (rule π”Šπ”‰) 
      have "β„›βˆ˜ (cf_const (cat_1 0 0) 𝔅 b⦇ObjMap⦈) = set {b}" 
        unfolding dghm_const_components cat_1_components by simp
      with vrange_𝔉 ba show False unfolding π”Š_def by simp  
    qed
    ultimately have "𝔅⦇Obj⦈ = set {a}" by simp
    with that show ?thesis by simp
  qed

  have 𝔅_Arr: "𝔅⦇Arr⦈ = set {𝔅⦇CIdβ¦ˆβ¦‡a⦈}"
  proof(rule vsubset_antisym)
    from 𝔅_Obj show "set {𝔅⦇CIdβ¦ˆβ¦‡a⦈} βŠ†βˆ˜ 𝔅⦇Arr⦈" 
      by (blast intro: 𝔅.cat_is_arrD(1) cat_cs_intros)
    show "𝔅⦇Arr⦈ βŠ†βˆ˜ set {𝔅⦇CIdβ¦ˆβ¦‡a⦈}"
    proof(intro vsubsetI)
      fix f assume "f ∈∘ 𝔅⦇Arr⦈" 
      with 𝔅_Obj have f: "f : a ↦𝔅 a"
        by (metis 𝔅.cat_is_arrD(2,3) is_arrI vsingleton_iff)
      from f have "cf_const 𝔅 𝔅 a : 𝔅 ↦↦CΞ± 𝔅"
        by (intro cf_const_is_functor) (auto simp: 𝔅.category_axioms)
      moreover from f have "cf_id 𝔅 : 𝔅 ↦↦CΞ± 𝔅"
        by (intro category.cat_cf_id_is_functor)
          (auto simp: 𝔅.category_axioms)
      ultimately have "cf_const 𝔅 𝔅 a = cf_id 𝔅"
        by (metis prems(2) 𝔅.category_axioms)
      moreover from f have "cf_const 𝔅 𝔅 a⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔅⦇CIdβ¦ˆβ¦‡a⦈" 
        by (simp add: β€Ήf ∈∘ 𝔅⦇Arrβ¦ˆβ€Ί dghm_const_ArrMap_app)
      moreover from f have "cf_id 𝔅⦇ArrMapβ¦ˆβ¦‡f⦈ = f" 
        unfolding dghm_id_components by (simp add: cat_cs_intros)
      ultimately show "f ∈∘ set {𝔅⦇CIdβ¦ˆβ¦‡a⦈}" by simp
    qed
  qed

  have "𝔅 = cat_1 a (𝔅⦇CIdβ¦ˆβ¦‡a⦈)"
  proof(rule cat_eqI[of Ξ±], unfold cat_1_components)
    from 𝔅.cat_Arr_vsubset_Vset 𝔅_Arr show "category Ξ± (cat_1 a (𝔅⦇CIdβ¦ˆβ¦‡a⦈))"
      by (intro category_cat_1) (auto simp: a)
    show "𝔅⦇Arr⦈ = set {𝔅⦇CIdβ¦ˆβ¦‡a⦈}" by (simp add: 𝔅_Arr)
    then have "π’Ÿβˆ˜ (𝔅⦇Dom⦈) = set {𝔅⦇CIdβ¦ˆβ¦‡a⦈}" 
      by (simp add: cat_cs_simps cat_cs_intros)
    moreover have "β„›βˆ˜ (𝔅⦇Dom⦈) = set {a}"
      using 𝔅.cat_Dom_vrange 𝔅.cat_CId_is_arr 𝔅.cat_Dom_vdomain
      by (auto simp: 𝔅_Obj elim: 𝔅.Dom.vbrelation_vinE) (*slow*)
    ultimately show "𝔅⦇Dom⦈ = set {βŸ¨π”…β¦‡CIdβ¦ˆβ¦‡a⦈, a⟩}"
      using 𝔅.Dom.vsv_vdomain_vrange_vsingleton by simp
    have "π’Ÿβˆ˜ (𝔅⦇Cod⦈) = set {𝔅⦇CIdβ¦ˆβ¦‡a⦈}" 
      by (simp add: 𝔅_Arr cat_cs_simps)
    moreover have "β„›βˆ˜ (𝔅⦇Cod⦈) = set {a}"
      using 𝔅.cat_Cod_vrange 𝔅.cat_CId_is_arr 𝔅.cat_Cod_vdomain 
      by (auto simp: 𝔅_Obj elim: 𝔅.Cod.vbrelation_vinE) (*slow*)
    ultimately show "𝔅⦇Cod⦈ = set {βŸ¨π”…β¦‡CIdβ¦ˆβ¦‡a⦈, a⟩}"
      by (auto intro: 𝔅.Cod.vsv_vdomain_vrange_vsingleton)
    show "𝔅⦇Comp⦈ = set {⟨[𝔅⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡a⦈]∘, 𝔅⦇CIdβ¦ˆβ¦‡a⦈⟩}"
    proof(rule vsv_eqI)
      show dom: 
        "π’Ÿβˆ˜ (𝔅⦇Comp⦈) = π’Ÿβˆ˜ (set {⟨[𝔅⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡a⦈]∘, 𝔅⦇CIdβ¦ˆβ¦‡a⦈⟩})"
        unfolding vdomain_vsingleton
      proof(rule vsubset_antisym)
         show "π’Ÿβˆ˜ (𝔅⦇Comp⦈) βŠ†βˆ˜ set {[𝔅⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡a⦈]∘}"
           by (intro vsubsetI) 
             (metis 𝔅.cat_Comp_vdomain 𝔅_Arr vsingleton_iff 𝔅.cat_is_arrD(1))
        show "set {[𝔅⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡a⦈]∘} βŠ†βˆ˜ π’Ÿβˆ˜ (𝔅⦇Comp⦈)"
          by
            (
              metis
                𝔅_Obj vsingleton_iff 
                𝔅.cat_CId_is_arr
                𝔅.cat_Comp_vdomainI 
                vsubset_vsingleton_left
            )
      qed
      have "𝔅⦇CIdβ¦ˆβ¦‡a⦈ ∘A𝔅 𝔅⦇CIdβ¦ˆβ¦‡a⦈ = 𝔅⦇CIdβ¦ˆβ¦‡a⦈" 
        by (metis 𝔅_Obj 𝔅.cat_CId_is_arr 𝔅.cat_CId_left_left vsingletonI)
      then show "a' ∈∘ π’Ÿβˆ˜ (𝔅⦇Comp⦈) ⟹
        𝔅⦇Compβ¦ˆβ¦‡a'⦈ = set {⟨[𝔅⦇CIdβ¦ˆβ¦‡a⦈, 𝔅⦇CIdβ¦ˆβ¦‡a⦈]∘, 𝔅⦇CIdβ¦ˆβ¦‡a⦈⟩}⦇a'⦈"
        for a'
        unfolding dom by simp
    qed (auto simp: 𝔅_Obj 𝔅_Arr)
    have "π’Ÿβˆ˜ (𝔅⦇CId⦈) = set {a}" by (simp add: 𝔅_Obj 𝔅.cat_CId_vdomain)
    moreover then have "β„›βˆ˜ (𝔅⦇CId⦈) = set {𝔅⦇CIdβ¦ˆβ¦‡a⦈}"
      by 
        (
          metis 
            𝔅.CId.vdomain_atE 
            𝔅.CId.vsv_vdomain_vsingleton_vrange_vsingleton 
            vsingleton_iff
        )
    ultimately show "𝔅⦇CId⦈ = set {⟨a, 𝔅⦇CIdβ¦ˆβ¦‡a⦈⟩}"
      by (blast intro: 𝔅.CId.vsv_vdomain_vrange_vsingleton)
  qed (auto simp: 𝔅_Obj cat_cs_intros)

  with a that 𝔅.cat_Arr_vsubset_Vset 𝔅_Arr show ?thesis by auto

qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_CAT

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉCATβ€Ίβ€Ί
theory CZH_ECAT_CAT
  imports CZH_SMC_CAT
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The subsection presents the theory of the categories of β€ΉΞ±β€Ί-categories.
It continues the development that was initiated in sections 
\ref{sec:dg_CAT}-\ref{sec:smc_CAT}.
β€Ί

named_theorems cat_CAT_simps
named_theorems cat_CAT_intros



subsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_CAT :: "V β‡’ V"
  where "cat_CAT Ξ± =
    [
      set {β„­. category Ξ± β„­},
      all_cfs Ξ±, 
      (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomDom⦈),
      (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomCod⦈),
      (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_CAT Ξ±). π”Šπ”‰β¦‡0⦈ ∘CF π”Šπ”‰β¦‡1β„•β¦ˆ),
      (Ξ»β„­βˆˆβˆ˜set {β„­. category Ξ± β„­}. cf_id β„­)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_CAT_components:
  shows "cat_CAT α⦇Obj⦈ = set {β„­. category Ξ± β„­}"
    and "cat_CAT α⦇Arr⦈ = all_cfs Ξ±"
    and "cat_CAT α⦇Dom⦈ = (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomDom⦈)"
    and "cat_CAT α⦇Cod⦈ = (Ξ»π”‰βˆˆβˆ˜all_cfs Ξ±. 𝔉⦇HomCod⦈)"
    and "cat_CAT α⦇Comp⦈ = 
      (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (dg_CAT Ξ±). π”Šπ”‰β¦‡0⦈ ∘CF π”Šπ”‰β¦‡1β„•β¦ˆ)"
    and "cat_CAT α⦇CId⦈ = (Ξ»β„­βˆˆβˆ˜set {β„­. category Ξ± β„­}. cf_id β„­)"
  unfolding cat_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_CAT: "cat_smc (cat_CAT Ξ±) = smc_CAT Ξ±"
proof(rule vsv_eqI)
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_CAT Ξ±)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_CAT Ξ±) = 5β„•"
    unfolding smc_CAT_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_CAT Ξ±)) = π’Ÿβˆ˜ (smc_CAT Ξ±)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_CAT Ξ±)) ⟹ cat_smc (cat_CAT Ξ±)⦇a⦈ = smc_CAT α⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral,
        unfold cat_smc_def dg_field_simps cat_CAT_def smc_CAT_def
      )
      (auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_CAT_def)

lemmas_with [folded cat_smc_CAT, unfolded slicing_simps]: 
  ―‹Digraphβ€Ί
  cat_CAT_ObjI = smc_CAT_ObjI
  and cat_CAT_ObjD = smc_CAT_ObjD
  and cat_CAT_ObjE = smc_CAT_ObjE
  and cat_CAT_Obj_iff[cat_CAT_simps] = smc_CAT_Obj_iff  
  and cat_CAT_Dom_app[cat_CAT_simps] = smc_CAT_Dom_app
  and cat_CAT_Cod_app[cat_CAT_simps] = smc_CAT_Cod_app
  and cat_CAT_is_arrI = smc_CAT_is_arrI
  and cat_CAT_is_arrD = smc_CAT_is_arrD
  and cat_CAT_is_arrE = smc_CAT_is_arrE
  and cat_CAT_is_arr_iff[cat_CAT_simps] = smc_CAT_is_arr_iff

lemmas_with [folded cat_smc_CAT, unfolded slicing_simps, unfolded cat_smc_CAT]: 
  ―‹Semicategoryβ€Ί
  cat_CAT_Comp_vdomain = smc_CAT_Comp_vdomain
  and cat_CAT_composable_arrs_dg_CAT = smc_CAT_composable_arrs_dg_CAT
  and cat_CAT_Comp = smc_CAT_Comp
  and cat_CAT_Comp_app[cat_CAT_simps] = smc_CAT_Comp_app
  and cat_CAT_Comp_vrange = smc_CAT_Comp_vrange

lemmas_with (in 𝒡) [folded cat_smc_CAT, unfolded slicing_simps]: 
  ―‹Semicategoryβ€Ί
  cat_CAT_obj_initialI = smc_CAT_obj_initialI
  and cat_CAT_obj_initialD = smc_CAT_obj_initialD
  and cat_CAT_obj_initialE = smc_CAT_obj_initialE
  and cat_CAT_obj_initial_iff[cat_CAT_simps] = smc_CAT_obj_initial_iff
  and cat_CAT_obj_terminalI = smc_CAT_obj_terminalI
  and cat_CAT_obj_terminalE = smc_CAT_obj_terminalE



subsectionβ€ΉIdentityβ€Ί

lemma cat_CAT_CId_app[cat_CAT_simps]: 
  assumes "category Ξ± β„­"
  shows "cat_CAT α⦇CIdβ¦ˆβ¦‡β„­β¦ˆ = cf_id β„­"
  using assms unfolding cat_CAT_components by simp

lemma cat_CAT_CId_vdomain: "π’Ÿβˆ˜ (cat_CAT α⦇CId⦈) = set {β„­. category Ξ± β„­}"
  unfolding cat_CAT_components by auto

lemma cat_CAT_CId_vrange: "β„›βˆ˜ (cat_CAT α⦇CId⦈) βŠ†βˆ˜ all_cfs Ξ±"
proof(rule vsubsetI)
  fix β„Œ assume "β„Œ ∈∘ β„›βˆ˜ (cat_CAT α⦇CId⦈)"
  then obtain 𝔄 
    where β„Œ_def: "β„Œ = cat_CAT α⦇CIdβ¦ˆβ¦‡π”„β¦ˆ" 
      and 𝔄: "𝔄 ∈∘ π’Ÿβˆ˜ (cat_CAT α⦇CId⦈)"
    unfolding cat_CAT_components by auto
  from 𝔄 have β„Œ_def': "β„Œ = cf_id 𝔄" 
    unfolding β„Œ_def cat_CAT_CId_vdomain by (auto simp: cat_CAT_CId_app)
  from 𝔄 category.cat_cf_id_is_functor show "β„Œ ∈∘ all_cfs Ξ±"
    unfolding β„Œ_def' cat_CAT_CId_vdomain by force
qed



subsectionβ€Ήβ€ΉCATβ€Ί is a categoryβ€Ί

lemma (in 𝒡) tiny_category_cat_CAT: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_category Ξ² (cat_CAT Ξ±)"
proof(intro tiny_categoryI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "vfsequence (cat_CAT Ξ±)" unfolding cat_CAT_def by simp
  show "vcard (cat_CAT Ξ±) = 6β„•"
    unfolding cat_CAT_def by (simp add: nat_omega_simps)
  show "𝔉 : 𝔄 ↦cat_CAT Ξ± 𝔅 ⟹ cat_CAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ ∘Acat_CAT Ξ± 𝔉 = 𝔉" 
    for 𝔉 𝔄 𝔅
  proof-
    assume prems: "𝔉 : 𝔄 ↦cat_CAT Ξ± 𝔅"
    then have b: "category Ξ± 𝔅" unfolding cat_CAT_is_arr_iff by auto
    with digraph.dg_dghm_id_is_dghm have 
      "cat_CAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ : 𝔅 ↦cat_CAT Ξ± 𝔅"
      by 
        (
          simp add: 
            cat_CAT_CId_app cat_CAT_is_arrI category.cat_cf_id_is_functor
        )
    with prems b show "cat_CAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ ∘Acat_CAT Ξ± 𝔉 = 𝔉" 
      by
        (
          simp add: 
            cat_CAT_CId_app 
            cat_CAT_Comp_app 
            cat_CAT_is_arr_iff
            is_functor.cf_cf_comp_cf_id_left
        )
  qed
  show "𝔉 : 𝔅 ↦cat_CAT Ξ± β„­ ⟹ 𝔉 ∘Acat_CAT Ξ± cat_CAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ = 𝔉" 
    for 𝔉 𝔅 β„­
  proof-
    assume prems: "𝔉 : 𝔅 ↦cat_CAT Ξ± β„­"
    then have b: "category Ξ± 𝔅" unfolding cat_CAT_is_arr_iff by auto
    then have "cat_CAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ : 𝔅 ↦cat_CAT Ξ± 𝔅"
      by 
        (
          simp add: 
            cat_CAT_CId_app cat_CAT_is_arrI category.cat_cf_id_is_functor
        )
    with prems b show "𝔉 ∘Acat_CAT Ξ± cat_CAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ = 𝔉"
      by 
        (
          auto 
            simp: cat_CAT_CId_app cat_CAT_Comp_app cat_CAT_is_arr_iff
            intro: is_functor.cf_cf_comp_cf_id_right 
        )
  qed
qed 
  (
    simp_all add:
      assms
      cat_smc_CAT
      cat_CAT_components 
      𝒡.intro 
      𝒡_Limit_Ξ±Ο‰ 
      𝒡_Ο‰_Ξ±Ο‰
      cat_CAT_is_arr_iff
      tiny_semicategory_smc_CAT
      category.cat_cf_id_is_functor
  )

lemmas [cat_cs_intros] = 𝒡.tiny_category_cat_CAT



subsectionβ€ΉIsomorphismβ€Ί

lemma (in 𝒡) cat_CAT_is_arr_isomorphismI: 
  assumes "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  shows "𝔉 : 𝔄 ↦isocat_CAT Ξ± 𝔅"
proof(intro is_arr_isomorphismI is_inverseI)
  from assms show 𝔉: "𝔉 : 𝔄 ↦cat_CAT Ξ± 𝔅"
    unfolding cat_CAT_is_arr_iff by auto
  note iso_thms = is_iso_functor_is_arr_isomorphism[OF assms]
  from iso_thms(1) show inv_𝔉: "inv_cf 𝔉 : 𝔅 ↦cat_CAT Ξ± 𝔄"
    unfolding cat_CAT_is_arr_iff by auto
  from assms show "𝔉 : 𝔄 ↦cat_CAT Ξ± 𝔅"
    unfolding cat_CAT_is_arr_iff by auto
  from assms have 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅" by auto
  show "inv_cf 𝔉 ∘Acat_CAT Ξ± 𝔉 = cat_CAT α⦇CIdβ¦ˆβ¦‡π”„β¦ˆ"
    unfolding cat_CAT_CId_app[OF 𝔄] cat_CAT_Comp_app[OF inv_𝔉 𝔉]
    by (rule iso_thms(2))
  show "𝔉 ∘Acat_CAT Ξ± inv_cf 𝔉 = cat_CAT α⦇CIdβ¦ˆβ¦‡π”…β¦ˆ"
    unfolding cat_CAT_CId_app[OF 𝔅] cat_CAT_Comp_app[OF 𝔉 inv_𝔉]
    by (rule iso_thms(3))
qed

lemma (in 𝒡) cat_CAT_is_arr_isomorphismD: 
  assumes "𝔉 : 𝔄 ↦isocat_CAT Ξ± 𝔅"
  shows "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
proof-
  from is_arr_isomorphismD[OF assms] have 𝔉: "𝔉 : 𝔄 ↦cat_CAT Ξ± 𝔅" 
    and "(βˆƒπ”Š. is_inverse (cat_CAT Ξ±) π”Š 𝔉)"
    by simp_all
  then obtain π”Š where "is_inverse (cat_CAT Ξ±) π”Š 𝔉" by clarsimp
  then obtain 𝔄' 𝔅' where π”Š': "π”Š : 𝔅' ↦cat_CAT Ξ± 𝔄'"
    and 𝔉': "𝔉 : 𝔄' ↦cat_CAT Ξ± 𝔅'"
    and π”Šπ”‰: "π”Š ∘Acat_CAT Ξ± 𝔉 = cat_CAT α⦇CIdβ¦ˆβ¦‡π”„'⦈"
    and π”‰π”Š: "𝔉 ∘Acat_CAT Ξ± π”Š = cat_CAT α⦇CIdβ¦ˆβ¦‡π”…'⦈"
    by auto
  from 𝔉 𝔉' have 𝔄': "𝔄' = 𝔄" and 𝔅': "𝔅' = 𝔅" by auto  
  from 𝔉 have 𝔉: "𝔉 : 𝔄 ↦↦CΞ± 𝔅" unfolding cat_CAT_is_arr_iff by simp
  then have 𝔄: "category Ξ± 𝔄" and 𝔅: "category Ξ± 𝔅" by auto
  from π”Š' have "π”Š : 𝔅 ↦↦CΞ± 𝔄" 
    unfolding 𝔄' 𝔅' cat_CAT_is_arr_iff by simp
  moreover from π”Šπ”‰ have "π”Š ∘CF 𝔉 = cf_id 𝔄"
    unfolding 𝔄' cat_CAT_Comp_app[OF π”Š' 𝔉'] cat_CAT_CId_app[OF 𝔄] 
    by simp
  moreover from π”‰π”Š have "𝔉 ∘CF π”Š = cf_id 𝔅"
    unfolding 𝔅' cat_CAT_Comp_app[OF 𝔉' π”Š'] cat_CAT_CId_app[OF 𝔅] 
    by simp
  ultimately show ?thesis 
    using 𝔉 by (elim is_arr_isomorphism_is_iso_functor)
qed

lemma (in 𝒡) cat_CAT_is_arr_isomorphismE: 
  assumes "𝔉 : 𝔄 ↦isocat_CAT Ξ± 𝔅"
  obtains "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  using assms by (auto dest: cat_CAT_is_arr_isomorphismD)

lemma (in 𝒡) cat_CAT_is_arr_isomorphism_iff[cat_CAT_simps]: 
  "𝔉 : 𝔄 ↦isocat_CAT Ξ± 𝔅 ⟷ 𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
  using cat_CAT_is_arr_isomorphismI cat_CAT_is_arr_isomorphismD by auto



subsectionβ€ΉIsomorphic objectsβ€Ί

lemma (in 𝒡) cat_CAT_obj_isoI: 
  assumes "𝔄 β‰ˆCΞ± 𝔅"
  shows "𝔄 β‰ˆobjcat_CAT Ξ± 𝔅"
proof-
  from iso_categoryD[OF assms] obtain 𝔉 where "𝔉 : 𝔄 ↦↦C.isoΞ± 𝔅"
    by clarsimp
  from cat_CAT_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
qed

lemma (in 𝒡) cat_CAT_obj_isoD: 
  assumes "𝔄 β‰ˆobjcat_CAT Ξ± 𝔅"
  shows "𝔄 β‰ˆCΞ± 𝔅"
proof-
  from obj_isoD[OF assms] obtain 𝔉 where "𝔉 : 𝔄 ↦isocat_CAT Ξ± 𝔅" 
    by clarsimp
  from cat_CAT_is_arr_isomorphismD[OF this] show ?thesis by (rule iso_categoryI)
qed

lemma (in 𝒡) cat_CAT_obj_isoE: 
  assumes "𝔄 β‰ˆobjcat_CAT Ξ± 𝔅"
  obtains "𝔄 β‰ˆCΞ± 𝔅"
  using assms by (auto simp: cat_CAT_obj_isoD)

lemma (in 𝒡) cat_CAT_obj_iso_iff[cat_CAT_simps]: 
  "𝔄 β‰ˆobjcat_CAT Ξ± 𝔅 ⟷ 𝔄 β‰ˆCΞ± 𝔅"
  using cat_CAT_obj_isoI cat_CAT_obj_isoD by (intro iffI) auto

textβ€Ή\newpageβ€Ί

end

Theory CZH_DG_FUNCT

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉFUNCTβ€Ί and β€ΉFunctβ€Ί as digraphs\label{sec:dg_FUNCT}β€Ί
theory CZH_DG_FUNCT
  imports 
    CZH_ECAT_Small_NTCF
    CZH_Foundations.CZH_DG_Subdigraph
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
A general reference for this section is Chapter II-4 in 
\cite{mac_lane_categories_2010}.
β€Ί

named_theorems dg_FUNCT_cs_simps
named_theorems dg_FUNCT_cs_intros
named_theorems cat_map_cs_simps
named_theorems cat_map_cs_intros



subsectionβ€ΉFunctor mapβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_map :: "V β‡’ V"
  where "cf_map 𝔉 = [𝔉⦇ObjMap⦈, 𝔉⦇ArrMap⦈]∘"

abbreviation cf_maps :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_maps Ξ± 𝔄 𝔅 ≑ set {cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}"

abbreviation tm_cf_maps :: "V β‡’ V β‡’ V β‡’ V"
  where "tm_cf_maps Ξ± 𝔄 𝔅 ≑ set {cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅}"

lemma tm_cf_maps_subset_cf_maps:
  "{cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅} βŠ† {cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}"
  by auto


textβ€ΉComponents.β€Ί

lemma cf_map_components[cat_map_cs_simps]:
  shows "cf_map 𝔉⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    and "cf_map 𝔉⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
  unfolding cf_map_def dghm_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSequence characterization.β€Ί

lemma dg_FUNCT_Obj_components:
  shows "[FOM, FAM]βˆ˜β¦‡ObjMap⦈ = FOM"
    and "[FOM, FAM]βˆ˜β¦‡ArrMap⦈ = FAM"
  unfolding dghm_field_simps by (simp_all add: nat_omega_simps)

lemma cf_map_vfsequence[cat_map_cs_intros]: "vfsequence (cf_map 𝔉)"
  unfolding cf_map_def by auto

lemma cf_map_vdomain[cat_map_cs_simps]: "π’Ÿβˆ˜ (cf_map 𝔉) = 2β„•"
  unfolding cf_map_def by (simp add: nat_omega_simps)

lemma (in is_functor) cf_map_vsubset_cf: "cf_map 𝔉 βŠ†βˆ˜ 𝔉"
  by (unfold cf_map_def, subst (3) cf_def)
    (cs_concl cs_intro: vcons_vsubset' V_cs_intros)


textβ€ΉSize.β€Ί

lemma (in is_functor) cf_map_ObjMap_in_Vset:
  assumes "α ∈∘ β"
  shows "cf_map 𝔉⦇ObjMap⦈ ∈∘ Vset Ξ²"
  using assms unfolding cf_map_components by (intro cf_ObjMap_in_Vset)

lemma (in is_tm_functor) tm_cf_map_ObjMap_in_Vset: "cf_map 𝔉⦇ObjMap⦈ ∈∘ Vset Ξ±"
  unfolding cf_map_components by (rule tm_cf_ObjMap_in_Vset)

lemma (in is_functor) cf_map_ArrMap_in_Vset:
  assumes "α ∈∘ β"
  shows "cf_map 𝔉⦇ArrMap⦈ ∈∘ Vset Ξ²"
  using assms unfolding cf_map_components by (intro cf_ArrMap_in_Vset)

lemma (in is_tm_functor) tm_cf_map_ArrMap_in_Vset: "cf_map 𝔉⦇ArrMap⦈ ∈∘ Vset Ξ±"
  unfolding cf_map_components by (rule tm_cf_ArrMap_in_Vset)

lemma (in is_functor) cf_map_in_Vset_4: "cf_map 𝔉 ∈∘ Vset (Ξ± + 4β„•)"
proof-
  note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
    cf_ObjMap_vsubset_Vset 
    cf_ArrMap_vsubset_Vset
  show ?thesis
    by (subst cf_map_def, succ_of_numeral)
      (
        cs_concl 
          cs_simp: plus_V_succ_right V_cs_simps 
          cs_intro: cat_cs_intros V_cs_intros
      )
qed

lemma (in is_tm_functor) tm_cf_map_in_Vset: "cf_map 𝔉 ∈∘ Vset Ξ±"
  using tm_cf_ObjMap_in_Vset tm_cf_ArrMap_in_Vset unfolding cf_map_def
  by (cs_concl cs_intro: V_cs_intros)

lemma (in is_functor) cf_map_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"  
  shows "cf_map 𝔉 ∈∘ Vset Ξ²"
  using assms cf_map_in_Vset_4 cf_map_vsubset_cf  
  by (auto intro!: cf_in_Vset)

lemma cf_maps_subset_Vset:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "{cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅} βŠ† elts (Vset Ξ²)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
  fix x 𝔉 assume x_def: "x = cf_map 𝔉" and 𝔉: "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  interpret is_functor Ξ± 𝔄 𝔅 𝔉 by (rule 𝔉)
  show "x ∈∘ Vset β" unfolding x_def by (rule cf_map_in_Vset[OF assms])
qed

lemma small_cf_maps[simp]: "small {cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅}"
proof(cases ‹𝒡 Ξ±β€Ί)
  case True
  from is_functor.cf_map_in_Vset show ?thesis
    by (intro down[of _ β€ΉVset (Ξ± + Ο‰)β€Ί])
      (auto simp: True 𝒡.𝒡_Limit_Ξ±Ο‰ 𝒡.𝒡_Ο‰_Ξ±Ο‰ 𝒡.intro 𝒡.𝒡_Ξ±_Ξ±Ο‰)
next
  case False
  then have "{cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦CΞ± 𝔅} = {}" by auto
  then show ?thesis by simp
qed

lemma small_tm_cf_maps[simp]: "small {cf_map 𝔉 | 𝔉. 𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅}"
  by (rule smaller_than_small[OF small_cf_maps tm_cf_maps_subset_cf_maps])

lemma (in 𝒡) cf_maps_in_Vset: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "cf_maps Ξ± 𝔄 𝔅 ∈∘ Vset Ξ²"
proof(rule vsubset_in_VsetI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "cf_maps Ξ± 𝔄 𝔅 βŠ†βˆ˜ Vset (Ξ± + 4β„•)"
  proof(intro vsubsetI)
    fix 𝔉 assume "𝔉 ∈∘ cf_maps Ξ± 𝔄 𝔅"
    then obtain 𝔄 𝔅 𝔉' where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉: "𝔉' : 𝔄 ↦↦CΞ± 𝔅" 
      by auto
    interpret is_functor Ξ± 𝔄 𝔅 𝔉' using 𝔉 by simp
    show "𝔉 ∈∘ Vset (Ξ± + 4β„•)" unfolding 𝔉_def by (rule cf_map_in_Vset_4)
  qed
  from assms(2) show "Vset (Ξ± + 4β„•) ∈∘ Vset Ξ²"
    by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed

lemma (in 𝒡) tm_cf_maps_vsubset_Vset: "tm_cf_maps Ξ± 𝔄 𝔅 βŠ†βˆ˜ Vset Ξ±"
proof(intro vsubsetI)
  fix 𝔉 assume "𝔉 ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
  then obtain 𝔄 𝔅 𝔉' 
    where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉: "𝔉' : 𝔄 ↦↦C.tmΞ± 𝔅"
    by auto
  then show "𝔉 ∈∘ Vset Ξ±" by (force simp: is_tm_functor.tm_cf_map_in_Vset)
qed


textβ€ΉRules.β€Ί

lemma (in is_functor) cf_mapsI: "cf_map 𝔉 ∈∘ cf_maps Ξ± 𝔄 𝔅" 
  by (auto intro: cat_cs_intros)

lemma (in is_tm_functor) tm_cf_mapsI: "cf_map 𝔉 ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
  by (auto intro: cat_small_cs_intros)

lemma (in is_functor) cf_mapsI':
  assumes "𝔉' = cf_map 𝔉"
  shows "𝔉' ∈∘ cf_maps Ξ± 𝔄 𝔅" 
  unfolding assms by (rule cf_mapsI)

lemma (in is_tm_functor) tm_cf_mapsI':
  assumes "𝔉' = cf_map 𝔉"
  shows "𝔉' ∈∘ tm_cf_maps Ξ± 𝔄 𝔅" 
  unfolding assms by (rule tm_cf_mapsI)

lemmas [cat_map_cs_intros] = 
  is_functor.cf_mapsI

lemmas cf_mapsI'[cat_map_cs_intros] = 
  is_functor.cf_mapsI'[rotated]

lemmas [cat_map_cs_intros] = 
  is_tm_functor.tm_cf_mapsI

lemmas tm_cf_mapsI'[cat_map_cs_intros] = 
  is_tm_functor.tm_cf_mapsI'[rotated]

lemma cf_mapsE[elim]:
  assumes "𝔉 ∈∘ cf_maps Ξ± 𝔄 𝔅"
  obtains π”Š where "𝔉 = cf_map π”Š" and "π”Š : 𝔄 ↦↦CΞ± 𝔅"
  using assms by force

lemma tm_cf_mapsE[elim]:
  assumes "𝔉 ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
  obtains π”Š where "𝔉 = cf_map π”Š" and "π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  using assms by force


textβ€ΉThe opposite functor map.β€Ί

lemma (in is_functor) cf_map_op_cf[cat_op_simps]: "cf_map (op_cf 𝔉) = cf_map 𝔉"
proof(rule vsv_eqI, unfold cat_map_cs_simps)
  show "a ∈∘ 2β„• ⟹ cf_map (op_cf 𝔉)⦇a⦈ = cf_map 𝔉⦇a⦈" for a
    by 
      (
        elim_in_numeral, 
        unfold dghm_field_simps[symmetric] cf_map_components cat_op_simps
      )
      simp_all
qed (auto intro: cat_map_cs_intros)

lemmas [cat_op_simps] = is_functor.cf_map_op_cf


textβ€ΉElementary properties.β€Ί

lemma tm_cf_maps_vsubset_cf_maps: "tm_cf_maps Ξ± 𝔄 𝔅 βŠ†βˆ˜ cf_maps Ξ± 𝔄 𝔅"
  using tm_cf_maps_subset_cf_maps by simp

lemma tm_cf_maps_in_cf_maps:
  assumes "𝔉 ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
  shows "𝔉 ∈∘ cf_maps Ξ± 𝔄 𝔅"
  using assms tm_cf_maps_vsubset_cf_maps[of Ξ± 𝔄 𝔅] by blast

lemma cf_map_inj:
  assumes "cf_map 𝔉 = cf_map π”Š" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and "π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔉 = π”Š"
proof(rule cf_eqI)
  from assms(1) have ObjMap: "cf_map 𝔉⦇ObjMap⦈ = cf_map π”Šβ¦‡ObjMap⦈" 
    and ArrMap: "cf_map 𝔉⦇ArrMap⦈ = cf_map π”Šβ¦‡ArrMap⦈" 
    by auto
  from ObjMap show "𝔉⦇ObjMap⦈ = π”Šβ¦‡ObjMap⦈" unfolding cf_map_components by simp
  from ArrMap show "𝔉⦇ArrMap⦈ = π”Šβ¦‡ArrMap⦈" unfolding cf_map_components by simp
qed (auto intro: assms(2,3))

lemma cf_map_eq_iff[cat_map_cs_simps]: 
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and "π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "cf_map 𝔉 = cf_map π”Š ⟷ 𝔉 = π”Š"
  using cf_map_inj[OF _ assms] by auto

lemma cf_map_eqI:
  assumes "𝔉 ∈∘ cf_maps Ξ± 𝔄 𝔅" 
    and "π”Š ∈∘ cf_maps Ξ± 𝔄 𝔅"
    and "𝔉⦇ObjMap⦈ = π”Šβ¦‡ObjMap⦈"
    and "𝔉⦇ArrMap⦈ = π”Šβ¦‡ArrMap⦈"
  shows "𝔉 = π”Š"
proof-
  from assms(1) obtain 𝔉' 
    where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉': "𝔉' : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  from assms(2) obtain π”Š'
    where π”Š_def: "π”Š = cf_map π”Š'" and π”Š': "π”Š' : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  show ?thesis
  proof(rule vsv_eqI, unfold 𝔉_def π”Š_def)
    show "a ∈∘ π’Ÿβˆ˜ (cf_map 𝔉') ⟹ cf_map 𝔉'⦇a⦈ = cf_map π”Š'⦇a⦈" for a
      by 
        (
          unfold cf_map_vdomain,
          elim_in_numeral,
          insert assms(3,4),
          unfold 𝔉_def π”Š_def
        )
        (auto simp: dghm_field_simps)
  qed (auto simp: cat_map_cs_simps intro: cat_map_cs_intros)
qed



subsectionβ€ΉConversion of a functor map to a functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_of_cf_map :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_of_cf_map 𝔄 𝔅 𝔉 = [𝔉⦇ObjMap⦈, 𝔉⦇ArrMap⦈, 𝔄, 𝔅]∘"


textβ€ΉComponents.β€Ί

lemma cf_of_cf_map_components[cat_map_cs_simps]:
  shows "cf_of_cf_map 𝔄 𝔅 𝔉⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    and "cf_of_cf_map 𝔄 𝔅 𝔉⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
    and "cf_of_cf_map 𝔄 𝔅 𝔉⦇HomDom⦈ = 𝔄"
    and "cf_of_cf_map 𝔄 𝔅 𝔉⦇HomCod⦈ = 𝔅"
  unfolding cf_of_cf_map_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉThe conversion of a functor map to a functor is a functorβ€Ί

lemma (in is_functor) cf_of_cf_map_is_functor: 
  "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉) : 𝔄 ↦↦CΞ± 𝔅"
proof(rule is_functorI')
  show "vfsequence (cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉))"
    unfolding cf_of_cf_map_def by simp
  show "vcard (cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)) = 4β„•"
    unfolding cf_of_cf_map_def by (simp add: nat_omega_simps)
  show
    "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ :
      cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅
      cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "f : a ↦𝔄 b" for a b f 
    unfolding cf_of_cf_map_components cf_map_components
    using is_functor_axioms that 
    by (cs_concl cs_intro: cat_cs_intros)
  show 
    "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡g ∘A𝔄 f⦈ =
      cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅
      cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈"
    if "g : b ↦𝔄 c" and "f : a ↦𝔄 b" for b c g a f
    using is_functor_axioms that 
    unfolding cf_of_cf_map_components cf_map_components
    by (cs_concl cs_simp: cat_cs_simps)
  show 
    "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 
      𝔅⦇CIdβ¦ˆβ¦‡cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
    if "c ∈∘ 𝔄⦇Obj⦈" for c
    using is_functor_axioms that 
    unfolding cf_of_cf_map_components cf_map_components
    by (cs_concl cs_simp: cat_cs_simps)
qed 
  (
    auto simp: 
      cat_cs_simps 
      cf_of_cf_map_components 
      cf_map_components 
      cf_ObjMap_vrange
      intro: cat_cs_intros
  )

lemma (in is_functor) cf_of_cf_map_is_functor': 
  assumes "𝔉' = cf_map 𝔉"
    and "𝔄' = 𝔄"
    and "𝔅' = 𝔅"
  shows "cf_of_cf_map 𝔄 𝔅 𝔉' : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms by (rule cf_of_cf_map_is_functor)

lemmas [cat_map_cs_intros] = is_functor.cf_of_cf_map_is_functor'


subsubsectionβ€ΉThe value of the conversion of a functor map to a functorβ€Ί

lemma (in is_functor) cf_of_cf_map_of_cf_map[cat_map_cs_simps]:
  "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉) = 𝔉"
proof(rule cf_eqI)
  show "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉) : 𝔄 ↦↦CΞ± 𝔅"
  proof(rule is_functorI')
    show "vfsequence (cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉))"
      unfolding cf_of_cf_map_def by auto
    show "vcard (cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)) = 4β„•"
      unfolding cf_of_cf_map_def by (simp add: nat_omega_simps)
    show
      "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ :
        cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅
        cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦𝔄 b" for a b f 
      unfolding cf_of_cf_map_components cf_map_components
      using is_functor_axioms that 
      by (cs_concl cs_intro: cat_cs_intros)
    show 
      "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡g ∘A𝔄 f⦈ =
        cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅
        cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦𝔄 c" and "f : a ↦𝔄 b" for b c g a f
      unfolding cf_of_cf_map_components cf_map_components
      using is_functor_axioms that 
      by (cs_concl cs_simp: cat_cs_simps)
    show 
      "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡c⦈⦈ =
        𝔅⦇CIdβ¦ˆβ¦‡cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉)⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ 𝔄⦇Obj⦈" for c
      unfolding cf_of_cf_map_components cf_map_components
      using is_functor_axioms that 
      by (cs_concl cs_simp: cat_cs_simps)
  qed 
    (
      auto simp: 
        cat_cs_simps 
        cf_of_cf_map_components 
        cf_map_components 
        cf_ObjMap_vrange 
        intro: cat_cs_intros
    )
qed (auto simp: cf_of_cf_map_components cf_map_components intro: cat_cs_intros)

lemmas [cat_map_cs_simps] = is_functor.cf_of_cf_map_of_cf_map



subsectionβ€ΉNatural transformation arrowβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition ntcf_arrow :: "V β‡’ V"
  where "ntcf_arrow 𝔑 = [𝔑⦇NTMap⦈, cf_map (𝔑⦇NTDom⦈), cf_map (𝔑⦇NTCod⦈)]∘"

abbreviation ntcf_arrows :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcf_arrows Ξ± 𝔄 𝔅 ≑
    set {ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"

abbreviation tm_ntcf_arrows :: "V β‡’ V β‡’ V β‡’ V"
  where "tm_ntcf_arrows Ξ± 𝔄 𝔅 ≑
    set {ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"

lemma tm_ntcf_arrows_subset_ntcf_arrows:
  "{ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅} βŠ†
    {ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"
  by auto


textβ€ΉComponents.β€Ί

lemma ntcf_arrow_components:
  shows [cat_map_cs_simps]: "ntcf_arrow 𝔑⦇NTMap⦈ = 𝔑⦇NTMap⦈"
    and "ntcf_arrow 𝔑⦇NTDom⦈ = cf_map (𝔑⦇NTDom⦈)"
    and "ntcf_arrow 𝔑⦇NTCod⦈ = cf_map (𝔑⦇NTCod⦈)"
  unfolding ntcf_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)

lemma (in is_ntcf) ntcf_arrow_components':
  shows "ntcf_arrow 𝔑⦇NTMap⦈ = 𝔑⦇NTMap⦈"
    and "ntcf_arrow 𝔑⦇NTDom⦈ = cf_map 𝔉"
    and "ntcf_arrow 𝔑⦇NTCod⦈ = cf_map π”Š"
  unfolding ntcf_arrow_components ntcf_NTDom ntcf_NTCod by simp_all

lemmas [cat_map_cs_simps] = is_ntcf.ntcf_arrow_components'(2,3)


textβ€ΉElementary properties.β€Ί

lemma dg_FUNCT_Arr_components:
  shows "[NTM, NTD, NTC]βˆ˜β¦‡NTMap⦈ = NTM"
    and "[NTM, NTD, NTC]βˆ˜β¦‡NTDom⦈ = NTD"
    and "[NTM, NTD, NTC]βˆ˜β¦‡NTCod⦈ = NTC"
  unfolding nt_field_simps by (simp_all add: nat_omega_simps)

lemma ntcf_arrow_vfsequence[cat_map_cs_intros]: "vfsequence (ntcf_arrow 𝔑)"
  unfolding ntcf_arrow_def by simp

lemma ntcf_arrow_vdomain[cat_map_cs_simps]: "π’Ÿβˆ˜ (ntcf_arrow 𝔑) = 3β„•"
  unfolding ntcf_arrow_def by (simp add: nat_omega_simps)


textβ€ΉSize.β€Ί

lemma (in is_ntcf) ntcf_arrow_NTMap_in_Vset:
  assumes "α ∈∘ β"
  shows "ntcf_arrow 𝔑⦇NTMap⦈ ∈∘ Vset Ξ²"
  using assms unfolding ntcf_arrow_components by (intro ntcf_NTMap_in_Vset)

lemma (in is_tm_ntcf) tm_ntcf_arrow_NTMap_in_Vset:
  "ntcf_arrow 𝔑⦇NTMap⦈ ∈∘ Vset Ξ±"
  unfolding ntcf_arrow_components by (rule tm_ntcf_NTMap_in_Vset)

lemma (in is_ntcf) ntcf_arrow_NTDom_in_Vset:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "ntcf_arrow 𝔑⦇NTDom⦈ ∈∘ Vset Ξ²"
  using assms unfolding ntcf_arrow_components' by (rule NTDom.cf_map_in_Vset)

lemma (in is_tm_ntcf) tm_ntcf_arrow_NTDom_in_Vset: 
  "ntcf_arrow 𝔑⦇NTDom⦈ ∈∘ Vset Ξ±"
  unfolding ntcf_arrow_components' by (rule NTDom.tm_cf_map_in_Vset)

lemma (in is_ntcf) ntcf_arrow_NTCod_in_Vset:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "ntcf_arrow 𝔑⦇NTCod⦈ ∈∘ Vset Ξ²"
  using assms unfolding ntcf_arrow_components' by (rule NTCod.cf_map_in_Vset)

lemma (in is_tm_ntcf) tm_ntcf_arrow_NTCod_in_Vset: 
  "ntcf_arrow 𝔑⦇NTCod⦈ ∈∘ Vset Ξ±"
  unfolding ntcf_arrow_components' by (rule NTCod.tm_cf_map_in_Vset)

lemma (in is_ntcf) ntcf_arrow_in_Vset:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "ntcf_arrow 𝔑 ∈∘ Vset Ξ²"
proof-
  interpret ntcf_arrow: vfsequence β€Ήntcf_arrow 𝔑› 
    by (auto intro: cat_map_cs_intros)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show ?thesis
  proof(rule vsv.vsv_Limit_vsv_in_VsetI)
    from assms show "π’Ÿβˆ˜ (ntcf_arrow 𝔑) ∈∘ Vset Ξ²" 
      by (auto simp: cat_map_cs_simps)
    have "n ∈∘ π’Ÿβˆ˜ (ntcf_arrow 𝔑) ⟹ ntcf_arrow 𝔑⦇n⦈ ∈∘ Vset Ξ²" for n
      by
        (
          unfold ntcf_arrow_vdomain,
          elim_in_numeral, 
          allβ€Ήrewrite in "βŒ‘ ∈∘ _" nt_field_simps[symmetric]β€Ί, 
          insert assms,
          unfold ntcf_arrow_components'
        )
        (
          auto intro: 
            ntcf_NTMap_in_Vset NTDom.cf_map_in_Vset NTCod.cf_map_in_Vset
        )
    with ntcf_arrow.vsv_vrange_vsubset show "β„›βˆ˜ (ntcf_arrow 𝔑) βŠ†βˆ˜ Vset Ξ²"  
      by simp
  qed (auto simp: cat_map_cs_simps)
qed

lemma (in is_tm_ntcf) tm_ntcf_arrow_in_Vset: "ntcf_arrow 𝔑 ∈∘ Vset Ξ±"
proof-
  interpret tm_ntcf_arrow: vfsequence β€Ήntcf_arrow 𝔑› 
    by (auto intro: cat_map_cs_intros)
  show ?thesis
  proof(rule vsv.vsv_Limit_vsv_in_VsetI)
    have "n ∈∘ π’Ÿβˆ˜ (ntcf_arrow 𝔑) ⟹ ntcf_arrow 𝔑⦇n⦈ ∈∘ Vset Ξ±" for n
      by 
        (
          unfold ntcf_arrow_vdomain,
          elim_in_numeral, 
          allβ€Ήrewrite in "βŒ‘ ∈∘ _" nt_field_simps[symmetric]β€Ί
        )
        (
          intro tm_ntcf_arrow_NTMap_in_Vset
          tm_ntcf_arrow_NTDom_in_Vset
          tm_ntcf_arrow_NTCod_in_Vset
        )+
    with tm_ntcf_arrow.vsv_vrange_vsubset show "β„›βˆ˜ (ntcf_arrow 𝔑) βŠ†βˆ˜ Vset Ξ±"  
      by auto
  qed (auto simp: cat_map_cs_simps)
qed

lemma ntcf_arrows_subset_Vset:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows 
    "{ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅} βŠ† elts (Vset Ξ²)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
  fix x 𝔑 𝔉 π”Š assume x_def: "x = ntcf_arrow 𝔑" 
    and 𝔑: "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  interpret is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑  by (rule 𝔑)
  show "x ∈∘ Vset β" unfolding x_def by (rule ntcf_arrow_in_Vset[OF assms])
qed

lemma tm_ntcf_arrows_subset_Vset:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows 
    "{ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅} βŠ†
      elts (Vset Ξ²)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
  fix x 𝔑 𝔉 π”Š assume x_def: "x = ntcf_arrow 𝔑" 
    and 𝔑: "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  interpret is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑  by (rule 𝔑)
  show "x ∈∘ Vset β" unfolding x_def by (rule ntcf_arrow_in_Vset[OF assms])
qed

lemma small_ntcf_arrows[simp]: 
  "small {ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅}"
proof(cases ‹𝒡 Ξ±β€Ί)
  case True
  from is_ntcf.ntcf_arrow_in_Vset show ?thesis
    by (intro down[of _ β€ΉVset (Ξ± + Ο‰)β€Ί])
      (auto simp: True 𝒡.𝒡_Limit_Ξ±Ο‰ 𝒡.𝒡_Ο‰_Ξ±Ο‰ 𝒡.intro 𝒡.𝒡_Ξ±_Ξ±Ο‰)
next
  case False
  then have "{ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅} = {}" 
    by auto
  then show ?thesis by simp
qed

lemma small_tm_ntcf_arrows[simp]: 
  "small {ntcf_arrow 𝔑 | 𝔑. βˆƒπ”‰ π”Š. 𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅}"
  by 
    ( 
      rule smaller_than_small[
        OF small_ntcf_arrows tm_ntcf_arrows_subset_ntcf_arrows
        ]
    )

lemma (in is_ntcf) ntcf_arrow_in_Vset_7: "ntcf_arrow 𝔑 ∈∘ Vset (Ξ± + 7β„•)"
proof-
  note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
    ntcf_NTMap_vsubset_Vset 
  from NTDom.cf_map_in_Vset_4 have [cat_cs_intros]:
    "cf_map 𝔉 ∈∘ Vset (succ (succ (succ (succ Ξ±))))"
    by succ_of_numeral (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
  from NTCod.cf_map_in_Vset_4 have [cat_cs_intros]:
    "cf_map π”Š ∈∘ Vset (succ (succ (succ (succ Ξ±))))"
    by succ_of_numeral (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
  show ?thesis
    by (subst ntcf_arrow_def, succ_of_numeral, unfold cat_cs_simps)
      (
        cs_concl 
          cs_simp: plus_V_succ_right V_cs_simps 
          cs_intro: V_cs_intros cat_cs_intros
      )
qed

lemma (in 𝒡) ntcf_arrows_in_Vset:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "ntcf_arrows Ξ± 𝔄 𝔅 ∈∘ Vset Ξ²"
proof(rule vsubset_in_VsetI)
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "ntcf_arrows Ξ± 𝔄 𝔅 βŠ†βˆ˜ Vset (Ξ± + 7β„•)"
  proof(intro vsubsetI)
    fix 𝔑 assume "𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    then obtain 𝔑' 𝔉 π”Š 
      where 𝔑_def: "𝔑 = ntcf_arrow 𝔑'" 
        and 𝔑': "𝔑' : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
      by clarsimp
    interpret is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑' using 𝔑' by simp
    show "𝔑 ∈∘ Vset (Ξ± + 7β„•)" unfolding 𝔑_def by (rule ntcf_arrow_in_Vset_7)
  qed
  from assms(2) show "Vset (Ξ± + 7β„•) ∈∘ Vset Ξ²"
    by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed
  
lemma (in 𝒡) tm_ntcf_arrows_vsubset_Vset: "tm_ntcf_arrows Ξ± 𝔄 𝔅 βŠ†βˆ˜ Vset Ξ±"
  by (clarsimp simp: is_tm_ntcf.tm_ntcf_arrow_in_Vset)


textβ€ΉRules.β€Ί

lemma (in is_ntcf) ntcf_arrowsI: "ntcf_arrow 𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
  using is_ntcf_axioms by auto

lemma (in is_tm_ntcf) tm_ntcf_arrowsI: "ntcf_arrow 𝔑 ∈∘ tm_ntcf_arrows Ξ± 𝔄 𝔅"
  using is_ntcf_axioms by (auto intro: cat_small_cs_intros)

lemma (in is_ntcf) ntcf_arrowsI': 
  assumes "𝔑' = ntcf_arrow 𝔑"
  shows "𝔑' ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
  unfolding assms(1) by (rule ntcf_arrowsI)

lemma (in is_tm_ntcf) tm_ntcf_arrowsI': 
  assumes "𝔑' = ntcf_arrow 𝔑"
  shows "𝔑' ∈∘ tm_ntcf_arrows Ξ± 𝔄 𝔅"
  unfolding assms(1) by (rule tm_ntcf_arrowsI)

lemmas [cat_map_cs_intros] =
  is_ntcf.ntcf_arrowsI

lemmas ntcf_arrowsI'[cat_map_cs_intros] =
  is_ntcf.ntcf_arrowsI'[rotated]

lemmas [cat_map_cs_intros] =
  is_tm_ntcf.tm_ntcf_arrowsI

lemmas tm_ntcf_arrowsI'[cat_map_cs_intros] =
  is_tm_ntcf.tm_ntcf_arrowsI'[rotated]

lemma ntcf_arrowsE[elim]:
  assumes "𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
  obtains 𝔐 𝔉 π”Š where "𝔑 = ntcf_arrow 𝔐" and "𝔐 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
  using assms by auto

lemma tm_ntcf_arrowsE[elim]:
  assumes "𝔑 ∈∘ tm_ntcf_arrows Ξ± 𝔄 𝔅"
  obtains 𝔐 𝔉 π”Š where "𝔑 = ntcf_arrow 𝔐" 
    and "𝔐 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
  using assms by auto


textβ€ΉElementary properties.β€Ί

lemma tm_ntcf_arrows_vsubset_ntcf_arrows: 
  "tm_ntcf_arrows Ξ± 𝔄 𝔅 βŠ†βˆ˜ ntcf_arrows Ξ± 𝔄 𝔅"
  using tm_ntcf_arrows_subset_ntcf_arrows by auto

lemma tm_ntcf_arrows_in_cf_arrows[cat_map_cs_intros]:
  assumes "𝔑 ∈∘ tm_ntcf_arrows Ξ± 𝔄 𝔅"
  shows "𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
  using assms tm_ntcf_arrows_vsubset_ntcf_arrows[of Ξ± 𝔄 𝔅] by blast

lemma ntcf_arrow_inj:
  assumes "ntcf_arrow 𝔐 = ntcf_arrow 𝔑"
    and "𝔐 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔑 : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± 𝔅"
  shows "𝔐 = 𝔑"
proof(rule ntcf_eqI)
  interpret 𝔐: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔐 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉' π”Š' 𝔑 by (rule assms(3))
  from assms(1) have NTMap: "ntcf_arrow 𝔐⦇NTMap⦈ = ntcf_arrow 𝔑⦇NTMap⦈" 
    and NTDom: "ntcf_arrow 𝔐⦇NTDom⦈ = ntcf_arrow 𝔑⦇NTDom⦈"
    and NTCod: "ntcf_arrow 𝔐⦇NTCod⦈ = ntcf_arrow 𝔑⦇NTCod⦈"
    by auto
  from NTMap show "𝔐⦇NTMap⦈ = 𝔑⦇NTMap⦈" unfolding ntcf_arrow_components by simp
  from NTDom NTCod show "𝔐⦇NTDom⦈ = 𝔑⦇NTDom⦈" "𝔐⦇NTCod⦈ = 𝔑⦇NTCod⦈" 
    unfolding ntcf_arrow_components cf_map_components
    by 
      (
        auto simp: 
          cat_cs_simps 
          cf_map_eq_iff[OF 𝔐.NTDom.is_functor_axioms 𝔑.NTDom.is_functor_axioms]
          cf_map_eq_iff[OF 𝔐.NTCod.is_functor_axioms 𝔑.NTCod.is_functor_axioms]
      )
  from assms(2,3) show 
    "𝔐 : 𝔐⦇NTDom⦈ ↦CF 𝔐⦇NTCod⦈ : 𝔄 ↦↦CΞ± 𝔅"
    "𝔑 : 𝔑⦇NTDom⦈ ↦CF 𝔑⦇NTCod⦈ : 𝔄 ↦↦CΞ± 𝔅"
    by (auto simp: cat_cs_simps)
qed auto

lemma ntcf_arrow_eq_iff[cat_map_cs_simps]:
  assumes "𝔐 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" and "𝔑 : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± 𝔅"
  shows "ntcf_arrow 𝔐 = ntcf_arrow 𝔑 ⟷ 𝔐 = 𝔑"
  using ntcf_arrow_inj[OF _ assms] by auto

lemma ntcf_arrow_eqI:
  assumes "𝔐 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅" 
    and "𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    and "𝔐⦇NTMap⦈ = 𝔑⦇NTMap⦈"
    and "𝔐⦇NTDom⦈ = 𝔑⦇NTDom⦈"
    and "𝔐⦇NTCod⦈ = 𝔑⦇NTCod⦈"
  shows "𝔐 = 𝔑"
proof-
  from assms(1) obtain 𝔐' 𝔉 π”Š
    where 𝔐_def: "𝔐 = ntcf_arrow 𝔐'" and 𝔐': "𝔐' : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  from assms(2) obtain 𝔑' 𝔉' π”Š'
    where 𝔑_def: "𝔑 = ntcf_arrow 𝔑'" and 𝔑': "𝔑' : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  show ?thesis
  proof(rule vsv_eqI, unfold 𝔐_def 𝔑_def)
    show "a ∈∘ π’Ÿβˆ˜ (ntcf_arrow 𝔐') ⟹ ntcf_arrow 𝔐'⦇a⦈ = ntcf_arrow 𝔑'⦇a⦈" 
      for a
      by  
        (
          unfold ntcf_arrow_vdomain, 
          elim_in_numeral, 
          insert assms(3-5), 
          unfold 𝔐_def 𝔑_def,
          fold nt_field_simps
        )
        simp_all
  qed (auto intro: cat_map_cs_intros simp: cat_map_cs_simps)
qed



subsectionβ€Ή
Conversion of a natural transformation arrow to a natural transformation
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition ntcf_of_ntcf_arrow :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 =
    [
      𝔑⦇NTMap⦈,
      cf_of_cf_map 𝔄 𝔅 (𝔑⦇NTDom⦈),
      cf_of_cf_map 𝔄 𝔅 (𝔑⦇NTCod⦈),
      𝔄,
      𝔅
    ]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_of_ntcf_arrow_components[cat_map_cs_simps]:
  shows "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTMap⦈ = 𝔑⦇NTMap⦈"
    and "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTDom⦈ = cf_of_cf_map 𝔄 𝔅 (𝔑⦇NTDom⦈)"
    and "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTCod⦈ = cf_of_cf_map 𝔄 𝔅 (𝔑⦇NTCod⦈)"
    and "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTDGDom⦈ = 𝔄"
    and "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTDGCod⦈ = 𝔅"
  unfolding ntcf_of_ntcf_arrow_def nt_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€Ή
The conversion of a natural transformation arrow 
to a natural transformation is a natural transformation
β€Ί

lemma (in is_ntcf) ntcf_of_ntcf_arrow_is_ntcf: 
  "ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑) : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
proof(rule is_ntcfI')
  show "vfsequence (ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑))"
    unfolding ntcf_of_ntcf_arrow_def by auto
  show "vcard (ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑)) = 5β„•"
    unfolding ntcf_of_ntcf_arrow_def by (simp add: nat_omega_simps)
  show "ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈ :
    𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using is_ntcf_axioms that
    by (cs_concl cs_simp: cat_map_cs_simps cs_intro: cat_cs_intros)
  show "ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑)⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ =
    π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔅 ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑)⦇NTMapβ¦ˆβ¦‡a⦈"
    if "f : a ↦𝔄 b" for a b f
    using is_ntcf_axioms that
    by 
      (
        cs_concl 
          cs_simp: ntcf_Comp_commute cat_map_cs_simps cs_intro: cat_cs_intros
      )
qed (use is_ntcf_axioms in β€Ήauto simp: cat_cs_simps cat_map_cs_simpsβ€Ί)

lemma (in is_ntcf) ntcf_of_ntcf_arrow_is_ntcf': 
  assumes "𝔑' = ntcf_arrow 𝔑" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑' : 𝔉 ↦CF π”Š : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms by (rule ntcf_of_ntcf_arrow_is_ntcf)

lemmas [cat_map_cs_intros] = is_ntcf.ntcf_of_ntcf_arrow_is_ntcf'


subsubsectionβ€Ή
The composition of the conversion of a natural transformation arrow 
to a natural transformation
β€Ί

lemma (in is_ntcf) ntcf_of_ntcf_arrow[cat_map_cs_simps]:
  "ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑) = 𝔑"
  by (rule ntcf_eqI) 
    (auto simp: cat_map_cs_simps intro: cat_cs_intros ntcf_of_ntcf_arrow_is_ntcf)

lemmas [cat_map_cs_simps] = is_ntcf.ntcf_of_ntcf_arrow



subsectionβ€ΉComposition of the natural transformation arrowsβ€Ί

definition ntcf_arrow_vcomp :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_arrow_vcomp 𝔄 𝔅 𝔐 𝔑 =
    ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔐 βˆ™NTCF ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"

syntax "_ntcf_arrow_vcomp" :: "V β‡’ V β‡’ V β‡’ V β‡’ V" 
  (β€Ή(_/ βˆ™NTCFβ‡˜_,_⇙ _)β€Ί [55, 56, 57, 58] 55)
translations "𝔐 βˆ™NTCF𝔄,𝔅 𝔑" β‡Œ "CONST ntcf_arrow_vcomp 𝔄 𝔅 𝔐 𝔑"


textβ€ΉComponents.β€Ί

lemma (in is_ntcf) ntcf_arrow_vcomp_components:
  "(ntcf_arrow 𝔐 βˆ™NTCF𝔄,𝔅 ntcf_arrow 𝔑)⦇NTMap⦈ = (𝔐 βˆ™NTCF 𝔑)⦇NTMap⦈"
  "(ntcf_arrow 𝔐 βˆ™NTCF𝔄,𝔅 ntcf_arrow 𝔑)⦇NTDom⦈ = cf_map ((𝔐 βˆ™NTCF 𝔑)⦇NTDom⦈)"
  "(ntcf_arrow 𝔑 βˆ™NTCF𝔄,𝔅 ntcf_arrow 𝔐)⦇NTCod⦈ = cf_map ((𝔑 βˆ™NTCF 𝔐)⦇NTCod⦈)"
  unfolding 
    ntcf_arrow_vcomp_def
    ntsmcf_vcomp_components 
    ntcf_arrow_components 
    ntcf_of_ntcf_arrow_components
  by (simp_all add: cat_cs_simps cat_map_cs_simps)

lemmas [cat_map_cs_simps] = is_ntcf.ntcf_arrow_vcomp_components


textβ€ΉElementary properties.β€Ί

lemma ntcf_arrow_vcomp_ntcf_vcomp[cat_map_cs_simps]:
  assumes "𝔐 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± 𝔅" and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" 
  shows "ntcf_arrow 𝔐 βˆ™NTCF𝔄,𝔅 ntcf_arrow 𝔑 = ntcf_arrow (𝔐 βˆ™NTCF 𝔑)"
  by (rule ntcf_arrow_eqI, insert assms)
    (
      cs_concl
        cs_simp: ntcf_arrow_vcomp_def cat_map_cs_simps cat_cs_simps
        cs_intro: cat_map_cs_intros cat_cs_intros
    )+


subsectionβ€ΉIdentity natural transformation arrowβ€Ί

definition ntcf_arrow_id :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcf_arrow_id 𝔄 𝔅 𝔉 = ntcf_arrow (ntcf_id (cf_of_cf_map 𝔄 𝔅 𝔉))"


textβ€ΉComponents.β€Ί

lemma (in is_functor) ntcf_arrow_id_components:
  "(ntcf_arrow_id 𝔄 𝔅 (cf_map 𝔉))⦇NTMap⦈ = ntcf_id 𝔉⦇NTMap⦈"
  "(ntcf_arrow_id 𝔄 𝔅 (cf_map 𝔉))⦇NTDom⦈ = cf_map (ntcf_id 𝔉⦇NTDom⦈)"
  "(ntcf_arrow_id 𝔄 𝔅 (cf_map 𝔉))⦇NTCod⦈ = cf_map (ntcf_id 𝔉⦇NTCod⦈)"
  unfolding ntcf_arrow_id_def ntcf_arrow_components 
  by (simp_all add: cat_map_cs_simps)

lemmas [cat_map_cs_simps] = is_functor.ntcf_arrow_id_components


textβ€ΉIdentity natural transformation arrow is a natural transformation arrow.β€Ί

lemma ntcf_arrow_id_ntcf_id[cat_map_cs_simps]:
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅" 
  shows "ntcf_arrow_id 𝔄 𝔅 (cf_map 𝔉) = ntcf_arrow (ntcf_id 𝔉)"
  by (rule ntcf_arrow_eqI, insert assms, unfold ntcf_arrow_id_def)
    (
      cs_concl 
        cs_simp: cat_map_cs_simps cat_cs_simps 
        cs_intro: cat_map_cs_intros cat_cs_intros
    )



subsectionβ€Ήβ€ΉFUNCTβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition dg_FUNCT :: "V β‡’ V β‡’ V β‡’ V"
  where "dg_FUNCT Ξ± 𝔄 𝔅 =
    [
      cf_maps Ξ± 𝔄 𝔅,
      ntcf_arrows Ξ± 𝔄 𝔅,
      (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈),
      (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)
    ]∘"

lemmas [dg_FUNCT_cs_simps] = cat_map_cs_simps
lemmas [dg_FUNCT_cs_intros] = cat_map_cs_intros


textβ€ΉComponents.β€Ί

lemma dg_FUNCT_components: 
  shows "dg_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈ = cf_maps Ξ± 𝔄 𝔅"
    and "dg_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈ = ntcf_arrows Ξ± 𝔄 𝔅"
    and "dg_FUNCT Ξ± 𝔄 𝔅⦇Dom⦈ = (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈)"
    and "dg_FUNCT Ξ± 𝔄 𝔅⦇Cod⦈ = (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)"
  unfolding dg_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObjectsβ€Ί

lemma (in is_functor) dg_FUNCT_ObjI: "cf_map 𝔉 ∈∘ dg_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
  unfolding dg_FUNCT_components by (auto intro: cat_cs_intros)


subsubsectionβ€ΉDomain and codomainβ€Ί

mk_VLambda dg_FUNCT_components(3)
  |vsv dg_FUNCT_Dom_vsv[dg_FUNCT_cs_intros]|
  |vdomain dg_FUNCT_Dom_vdomain[dg_FUNCT_cs_simps]|

mk_VLambda dg_FUNCT_components(4)
  |vsv dg_FUNCT_Cod_vsv[dg_FUNCT_cs_intros]|
  |vdomain dg_FUNCT_Cod_vdomain[dg_FUNCT_cs_simps]|

lemma (in is_ntcf)
  shows dg_FUNCT_Dom_app: "dg_FUNCT Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map 𝔉"
    and dg_FUNCT_Cod_app: "dg_FUNCT Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map π”Š"
proof-
  from is_ntcf_axioms show 
    "dg_FUNCT Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map 𝔉"  
    "dg_FUNCT Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map π”Š"
    unfolding dg_FUNCT_components 
    by (cs_concl cs_simp: dg_FUNCT_cs_simps V_cs_simps cs_intro: dg_FUNCT_cs_intros)+
qed

lemma (in is_ntcf)
  assumes "𝔑' = ntcf_arrow 𝔑"
  shows dg_FUNCT_Dom_app': "dg_FUNCT Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡π”‘'⦈ = cf_map 𝔉"
    and dg_FUNCT_Cod_app': "dg_FUNCT Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡π”‘'⦈ = cf_map π”Š"
  unfolding assms by (intro dg_FUNCT_Dom_app dg_FUNCT_Cod_app)+

lemmas [dg_FUNCT_cs_simps] = 
  is_ntcf.dg_FUNCT_Dom_app'
  is_ntcf.dg_FUNCT_Cod_app'

lemma 
  shows dg_FUNCT_Dom_vrange: "β„›βˆ˜ (dg_FUNCT Ξ± 𝔄 𝔅⦇Dom⦈) βŠ†βˆ˜ dg_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
    and dg_FUNCT_Cod_vrange: "β„›βˆ˜ (dg_FUNCT Ξ± 𝔄 𝔅⦇Cod⦈) βŠ†βˆ˜ dg_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
  unfolding dg_FUNCT_components
proof(allβ€Ήintro vrange_VLambda_vsubsetβ€Ί)
  fix 𝔑 assume "𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
  then obtain 𝔐 𝔉 π”Š where 𝔑_def[dg_FUNCT_cs_simps]: "𝔑 = ntcf_arrow 𝔐" 
    and 𝔐: "𝔐 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  from 𝔐 show "𝔑⦇NTDom⦈ ∈∘ cf_maps Ξ± 𝔄 𝔅"
    by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: dg_FUNCT_cs_intros cat_cs_intros)
  from 𝔐 show "𝔑⦇NTCod⦈ ∈∘ cf_maps Ξ± 𝔄 𝔅"
    by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: dg_FUNCT_cs_intros cat_cs_intros)
qed


subsubsectionβ€Ήβ€ΉFUNCTβ€Ί is a tiny digraphβ€Ί

lemma (in 𝒡) tiny_digraph_dg_FUNCT:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_digraph Ξ² (dg_FUNCT Ξ± 𝔄 𝔅)"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show ?thesis
  proof(intro tiny_digraphI)
    show "vfsequence (dg_FUNCT Ξ± 𝔄 𝔅)" unfolding dg_FUNCT_def by simp
    show "vcard (dg_FUNCT Ξ± 𝔄 𝔅) = 4β„•"
      unfolding dg_FUNCT_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (dg_FUNCT Ξ± 𝔄 𝔅⦇Dom⦈) βŠ†βˆ˜ dg_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by (simp add: dg_FUNCT_Dom_vrange dg_FUNCT_Cod_vrange)
    show "β„›βˆ˜ (dg_FUNCT Ξ± 𝔄 𝔅⦇Cod⦈) βŠ†βˆ˜ dg_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by (simp add: dg_FUNCT_Dom_vrange dg_FUNCT_Cod_vrange)
    from assms show "dg_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈ ∈∘ Vset Ξ²"
      unfolding dg_FUNCT_components(1) by (rule cf_maps_in_Vset)
    show "dg_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈ ∈∘ Vset Ξ²"
      unfolding dg_FUNCT_components(2) by (rule ntcf_arrows_in_Vset[OF assms])
  qed (auto simp: dg_FUNCT_cs_simps dg_FUNCT_components(1,2) intro: dg_FUNCT_cs_intros)
qed


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma dg_FUNCT_is_arrI:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" 
  shows "ntcf_arrow 𝔑 : cf_map 𝔉 ↦dg_FUNCT Ξ± 𝔄 𝔅 cf_map π”Š"
proof(intro is_arrI, unfold dg_FUNCT_components(1,2))
  interpret is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms)
  from assms show "ntcf_arrow 𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅" by auto
  from assms show 
    "dg_FUNCT Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map 𝔉"
    "dg_FUNCT Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map π”Š"
    by (cs_concl cs_simp: dg_FUNCT_cs_simps)+
qed

lemma dg_FUNCT_is_arrI':
  assumes "𝔑' = ntcf_arrow 𝔑"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔉' = cf_map 𝔉"
    and "π”Š' = cf_map π”Š"
  shows "𝔑' : 𝔉' ↦dg_FUNCT Ξ± 𝔄 𝔅 π”Š'"
  using assms(2) unfolding assms(1,3,4) by (rule dg_FUNCT_is_arrI)

lemmas [dg_FUNCT_cs_intros] = dg_FUNCT_is_arrI'

lemma dg_FUNCT_is_arrD[dest]:
  assumes "𝔑 : 𝔉 ↦dg_FUNCT Ξ± 𝔄 𝔅 π”Š"
  shows "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 :
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
proof-
  note 𝔑 = is_arrD[OF assms, unfolded dg_FUNCT_components(2)]
  obtain 𝔑' 𝔉' π”Š' where 𝔑_def: "𝔑 = ntcf_arrow 𝔑'"
    and 𝔑': "𝔑' : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± 𝔅"
    by (elim ntcf_arrowsE[OF 𝔑(1)])
  from 𝔑(2) 𝔑' have 𝔉_def: "𝔉 = cf_map 𝔉'"
    by (cs_prems cs_simp: 𝔑_def dg_FUNCT_cs_simps) simp
  from 𝔑(3) 𝔑' have π”Š_def: "π”Š = cf_map π”Š'"
    by (cs_prems cs_simp: 𝔑_def dg_FUNCT_cs_simps) simp
  from 𝔑' have 𝔑'_def: "𝔑' = ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑"
    unfolding 𝔑_def by (cs_concl cs_simp: dg_FUNCT_cs_simps)
  from 𝔑' have 𝔉'_def: "𝔉' = cf_of_cf_map 𝔄 𝔅 𝔉"
    and π”Š'_def: "π”Š' = cf_of_cf_map 𝔄 𝔅 π”Š"
    unfolding 𝔉_def π”Š_def 
    by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: cat_cs_intros)+
  from 𝔑' show "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 :
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
    by (fold 𝔉'_def π”Š'_def 𝔑'_def 𝔉_def π”Š_def 𝔑_def) simp_all
qed

lemma dg_FUNCT_is_arrE[elim]:
  assumes "𝔑 : 𝔉 ↦dg_FUNCT Ξ± 𝔄 𝔅 π”Š"
  obtains 𝔑' 𝔉' π”Š' 
    where "𝔑' : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± 𝔅" 
      and "𝔑 = ntcf_arrow 𝔑'"
      and "𝔉 = cf_map 𝔉'" 
      and "π”Š = cf_map π”Š'"
  using dg_FUNCT_is_arrD[OF assms] by auto



subsectionβ€Ήβ€ΉFunctβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition dg_Funct :: "V β‡’ V β‡’ V β‡’ V"
  where "dg_Funct Ξ± 𝔄 𝔅 =
    [
      tm_cf_maps Ξ± 𝔄 𝔅,
      tm_ntcf_arrows Ξ± 𝔄 𝔅,
      (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈),
      (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma dg_Funct_components: 
  shows "dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈ = tm_cf_maps Ξ± 𝔄 𝔅"
    and "dg_Funct Ξ± 𝔄 𝔅⦇Arr⦈ = tm_ntcf_arrows Ξ± 𝔄 𝔅"
    and "dg_Funct Ξ± 𝔄 𝔅⦇Dom⦈ = (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈)"
    and "dg_Funct Ξ± 𝔄 𝔅⦇Cod⦈ = (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)"
  unfolding dg_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObjectsβ€Ί

lemma (in is_tm_functor) dg_Funct_ObjI: "cf_map 𝔉 ∈∘ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
  unfolding dg_Funct_components by (auto simp: cat_small_cs_intros)


subsubsectionβ€ΉDomain and codomainβ€Ί

mk_VLambda dg_Funct_components(3)
  |vsv dg_Funct_Dom_vsv[dg_FUNCT_cs_intros]|
  |vdomain dg_Funct_Dom_vdomain[dg_FUNCT_cs_simps]|

mk_VLambda dg_Funct_components(4)
  |vsv dg_Funct_Cod_vsv[dg_FUNCT_cs_intros]|
  |vdomain dg_Funct_Cod_vdomain[dg_FUNCT_cs_simps]|

lemma (in is_tm_ntcf)
  shows dg_Funct_Dom_app: "dg_Funct Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map 𝔉"
    and dg_Funct_Cod_app: "dg_Funct Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map π”Š"
proof-
  from is_tm_ntcf_axioms show 
    "dg_Funct Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map 𝔉"  
    "dg_Funct Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map π”Š"
    unfolding dg_Funct_components 
    by 
      (
        cs_concl 
          cs_simp: dg_FUNCT_cs_simps V_cs_simps 
          cs_intro: dg_FUNCT_cs_intros cat_cs_intros
      )+
qed

lemma (in is_tm_ntcf)
  assumes "𝔑' = ntcf_arrow 𝔑"
  shows dg_Funct_Dom_app': "dg_Funct Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡π”‘'⦈ = cf_map 𝔉"
    and dg_Funct_Cod_app': "dg_Funct Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡π”‘'⦈ = cf_map π”Š"
  unfolding assms by (intro dg_Funct_Dom_app dg_Funct_Cod_app)+

lemmas [dg_FUNCT_cs_simps] = 
  is_tm_ntcf.dg_Funct_Dom_app'
  is_tm_ntcf.dg_Funct_Cod_app'

lemma 
  shows dg_Funct_Dom_vrange: "β„›βˆ˜ (dg_Funct Ξ± 𝔄 𝔅⦇Dom⦈) βŠ†βˆ˜ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
    and dg_Funct_Cod_vrange: "β„›βˆ˜ (dg_Funct Ξ± 𝔄 𝔅⦇Cod⦈) βŠ†βˆ˜ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
  unfolding dg_Funct_components
proof(allβ€Ήintro vrange_VLambda_vsubsetβ€Ί)
  fix 𝔑 assume "𝔑 ∈∘ tm_ntcf_arrows Ξ± 𝔄 𝔅"
  then obtain 𝔐 𝔉 π”Š where 𝔑_def[dg_FUNCT_cs_simps]: "𝔑 = ntcf_arrow 𝔐" 
    and 𝔐: "𝔐 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
    by auto
  from 𝔐 show "𝔑⦇NTDom⦈ ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
    by 
      ( 
        cs_concl 
          cs_simp: dg_FUNCT_cs_simps 
          cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros
      )
  from 𝔐 show "𝔑⦇NTCod⦈ ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
    by 
      (
        cs_concl 
          cs_simp: dg_FUNCT_cs_simps 
          cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros
      )
qed


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma dg_Funct_is_arrI:
  assumes "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅" 
  shows "ntcf_arrow 𝔑 : cf_map 𝔉 ↦dg_Funct Ξ± 𝔄 𝔅 cf_map π”Š"
proof(intro is_arrI, unfold dg_Funct_components(1,2))
  interpret is_tm_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms)
  from assms show "ntcf_arrow 𝔑 ∈∘ tm_ntcf_arrows Ξ± 𝔄 𝔅" by auto
  from assms show 
    "dg_Funct Ξ± 𝔄 𝔅⦇Domβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map 𝔉"
    "dg_Funct Ξ± 𝔄 𝔅⦇Codβ¦ˆβ¦‡ntcf_arrow π”‘β¦ˆ = cf_map π”Š"
    by (cs_concl cs_simp: dg_FUNCT_cs_simps)+
qed

lemma dg_Funct_is_arrI':
  assumes "𝔑' = ntcf_arrow 𝔑"
    and "𝔑 : 𝔉 ↦CF.tm π”Š : 𝔄 ↦↦C.tmΞ± 𝔅" 
    and "𝔉' = cf_map 𝔉"
    and "π”Š' = cf_map π”Š"
  shows "𝔑' : 𝔉' ↦dg_Funct Ξ± 𝔄 𝔅 π”Š'"
  using assms(2) unfolding assms(1,3,4) by (rule dg_Funct_is_arrI)

lemmas [dg_FUNCT_cs_intros] = dg_Funct_is_arrI'

lemma dg_Funct_is_arrD[dest]:
  assumes "𝔑 : 𝔉 ↦dg_Funct Ξ± 𝔄 𝔅 π”Š"
  shows "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 :
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF.tm cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦C.tmΞ± 𝔅" 
    and "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
proof-
  note 𝔑 = is_arrD[OF assms, unfolded dg_Funct_components(2)]
  obtain 𝔑' 𝔉' π”Š' where 𝔑_def: "𝔑 = ntcf_arrow 𝔑'"
    and 𝔑': "𝔑' : 𝔉' ↦CF.tm π”Š' : 𝔄 ↦↦C.tmΞ± 𝔅"
    by (elim tm_ntcf_arrowsE[OF 𝔑(1)])
  from 𝔑(2) 𝔑' have 𝔉_def: "𝔉 = cf_map 𝔉'"
    by (cs_prems cs_simp: 𝔑_def dg_FUNCT_cs_simps) simp
  from 𝔑(3) 𝔑' have π”Š_def: "π”Š = cf_map π”Š'"
    by (cs_prems cs_simp: 𝔑_def dg_FUNCT_cs_simps) simp
  from 𝔑' have 𝔑'_def: "𝔑' = ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑"
    unfolding 𝔑_def 
    by 
      (
        cs_concl
          cs_simp: dg_FUNCT_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
      )
  from 𝔑' have 𝔉'_def: "𝔉' = cf_of_cf_map 𝔄 𝔅 𝔉"
    and π”Š'_def: "π”Š' = cf_of_cf_map 𝔄 𝔅 π”Š"
    unfolding 𝔉_def π”Š_def 
    by 
      (
        cs_concl 
          cs_simp: dg_FUNCT_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
      )+
  from 𝔑' show "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 :
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF.tm cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦C.tmΞ± 𝔅" 
    and "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
    by (fold 𝔉'_def π”Š'_def 𝔑'_def 𝔉_def π”Š_def 𝔑_def) simp_all
qed

lemma dg_Funct_is_arrE[elim]:
  assumes "𝔑 : 𝔉 ↦dg_Funct Ξ± 𝔄 𝔅 π”Š"
  obtains 𝔑' 𝔉' π”Š' where "𝔑' : 𝔉' ↦CF.tm π”Š' : 𝔄 ↦↦C.tmΞ± 𝔅" 
    and "𝔑 = ntcf_arrow 𝔑'"
    and "𝔉 = cf_map 𝔉'" 
    and "π”Š = cf_map π”Š'"
  using dg_Funct_is_arrD[OF assms] by auto


subsubsectionβ€Ήβ€ΉFunctβ€Ί is a digraphβ€Ί

lemma (in 𝒡) digraph_dg_Funct: 
  assumes "tiny_category Ξ± 𝔄" and "category Ξ± 𝔅"
  shows "digraph Ξ± (dg_Funct Ξ± 𝔄 𝔅)"
proof(intro digraphI)

  interpret tiny_category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: category Ξ± 𝔅 by (rule assms(2))

  show "vfsequence (dg_Funct Ξ± 𝔄 𝔅)" unfolding dg_Funct_def by simp
  show "vcard (dg_Funct Ξ± 𝔄 𝔅) = 4β„•"
    unfolding dg_Funct_def by (simp add: nat_omega_simps)
  show "β„›βˆ˜ (dg_Funct Ξ± 𝔄 𝔅⦇Dom⦈) βŠ†βˆ˜ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
    by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
  show "β„›βˆ˜ (dg_Funct Ξ± 𝔄 𝔅⦇Cod⦈) βŠ†βˆ˜ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
    by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
  show "dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    unfolding dg_Funct_components(1,2) by (rule tm_cf_maps_vsubset_Vset)
  
  have RA: 
    "(β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈)) ∈∘ Vset Ξ±"
    "(β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈)) βŠ†βˆ˜ 𝔅⦇Obj⦈"
    if "A βŠ†βˆ˜ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈" and "A ∈∘ Vset Ξ±" for A
  proof-
    have "(β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈)) βŠ†βˆ˜ 𝔅⦇Obj⦈" 
      and "(β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈)) βŠ†βˆ˜ β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜A)))))"
    proof(allβ€Ήintro vsubsetIβ€Ί)
      fix f assume "f ∈∘ (β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈))"
      then obtain 𝔉 where 𝔉: "𝔉 ∈∘ A" and f: "f ∈∘ β„›βˆ˜ (𝔉⦇ObjMap⦈)" by auto
      with that(1) have "𝔉 ∈∘ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈" by (elim vsubsetE)
      then obtain 𝔉'
        where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉': "𝔉' : 𝔄 ↦↦C.tmΞ± 𝔅"
        unfolding dg_Funct_components by auto
      interpret 𝔉': is_tm_functor Ξ± 𝔄 𝔅 𝔉' by (rule 𝔉')
      from f obtain a where "a ∈∘ π’Ÿβˆ˜ (𝔉'⦇ObjMap⦈)" and af: "⟨a, f⟩ ∈∘ 𝔉'⦇ObjMap⦈"
        unfolding 𝔉_def cf_map_components vdomain_iff by force
      then show "f ∈∘ 𝔅⦇Obj⦈"
        using 𝔉'.cf_ObjMap_vrange 𝔉_def cf_map_components(1) f vsubsetE by auto
      show "f ∈∘ β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜A)))))"
      proof(intro VUnionI)
        show "𝔉 ∈∘ A" by (rule 𝔉)
        show "set {0, 𝔉⦇ObjMap⦈} ∈∘ ⟨[]∘, 𝔉⦇ObjMap⦈⟩" unfolding vpair_def by simp
        show "⟨a, f⟩ ∈∘ 𝔉⦇ObjMap⦈"
          unfolding 𝔉_def cf_map_components by (intro af)
        show "set {a, f} ∈∘ ⟨a, f⟩" unfolding vpair_def by clarsimp
      qed (clarsimp simp: 𝔉_def cf_map_def dg_FUNCT_Obj_components)+
    qed
    moreover have "β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜(β‹ƒβˆ˜A))))) ∈∘ Vset Ξ±"
      by (intro VUnion_in_VsetI that(2))
    ultimately show 
      "(β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈)) ∈∘ Vset Ξ±" 
      "(β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈)) βŠ†βˆ˜ 𝔅⦇Obj⦈" 
      by blast+
  qed

  fix A B assume prems:
    "A βŠ†βˆ˜ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
    "B βŠ†βˆ˜ dg_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
    "A ∈∘ Vset α"
    "B ∈∘ Vset α"

  define ARs where "ARs = (β‹ƒβˆ˜π”‰βˆˆβˆ˜A. β„›βˆ˜ (𝔉⦇ObjMap⦈))"
  define BRs where "BRs = (β‹ƒβˆ˜π”Šβˆˆβˆ˜B. β„›βˆ˜ (π”Šβ¦‡ObjMap⦈))"
  define Hom_AB where "Hom_AB = (β‹ƒβˆ˜a∈∘ARs. β‹ƒβˆ˜b∈∘BRs. Hom 𝔅 a b)"

  define Q where
    "Q i = (if i = 0 then VPow (𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB) else if i = 1β„• then A else B)" 
    for i
  have 
    "{[𝔑, 𝔉, π”Š]∘ |𝔑 𝔉 π”Š. 𝔑 βŠ†βˆ˜ 𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB ∧ 𝔉 ∈∘ A ∧ π”Š ∈∘ B} βŠ†
      elts (∏∘i∈∘set {0, 1β„•, 2β„•}. Q i)"
  proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
    fix π”‘π”‰π”Š 𝔑 𝔉 π”Š assume prems': 
      "π”‘π”‰π”Š = [𝔑, 𝔉, π”Š]∘" "𝔑 βŠ†βˆ˜ 𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB" "𝔉 ∈∘ A" "π”Š ∈∘ B"
    show "π”‘π”‰π”Š ∈∘ (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
    proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
      show "π’Ÿβˆ˜ π”‘π”‰π”Š = set {0, 1β„•, 2β„•}"
        by (simp add: three prems'(1) nat_omega_simps)
      fix i assume "i ∈∘ set {0, 1β„•, 2β„•}"
      then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί | β€Ήi = 2β„•β€Ί by auto
      then show "π”‘π”‰π”Šβ¦‡i⦈ ∈∘ Q i"
        by cases (auto simp: Q_def prems' nat_omega_simps)
    qed (auto simp: prems'(1))
  qed
  moreover then have small[simp]: 
    "small {[r, a, b]∘ | r a b. r βŠ†βˆ˜π”„β¦‡Obj⦈ Γ—βˆ˜ Hom_AB ∧ a ∈∘ A ∧ b ∈∘ B}"
    by (rule down)
  ultimately have
    "set {[r, a, b]∘ |r a b. r βŠ†βˆ˜ 𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB ∧ a ∈∘ A ∧ b ∈∘ B} βŠ†βˆ˜
      (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
    by auto
  moreover have "(∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i) ∈∘ Vset Ξ±"
  proof(rule Limit_vproduct_in_VsetI)
    show "set {0, 1β„•, 2β„•} ∈∘ Vset Ξ±"
      by (cs_concl cs_intro: V_cs_intros cat_cs_intros cs_simp: V_cs_simps)
    have "Hom_AB ∈∘ Vset α"
      unfolding Hom_AB_def
      by 
        (
          intro 𝔅.cat_Hom_vifunion_in_Vset prems(3,4), 
          unfold ARs_def BRs_def; 
          intro RA prems
        )
    moreover have "𝔄⦇Obj⦈ ∈∘ Vset Ξ±" by (intro tiny_cat_Obj_in_Vset)
    ultimately have "VPow (𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB) ∈∘ Vset Ξ±"
      by (cs_concl cs_intro: V_cs_intros)
    with prems(3,4) show "Q i ∈∘ Vset Ξ±" if "i ∈∘ set {0, 1β„•, 2β„•}" for i
      unfolding Q_def by (simp_all add: nat_omega_simps)
  qed auto
  moreover have
    "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (dg_Funct Ξ± 𝔄 𝔅) a b) βŠ†βˆ˜
      set {[r, a, b]∘ | r a b. r βŠ†βˆ˜ 𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB ∧ a ∈∘ A ∧ b ∈∘ B}"
  proof(rule vsubsetI)
    fix 𝔑 assume "𝔑 ∈∘ (β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (dg_Funct Ξ± 𝔄 𝔅) a b)"
    then obtain 𝔉 π”Š 
      where 𝔉: "𝔉 ∈∘ A"
        and π”Š: "π”Š ∈∘ B"
        and 𝔑_ab: "𝔑 ∈∘ Hom (dg_Funct Ξ± 𝔄 𝔅) 𝔉 π”Š"
      by auto
    then have "𝔑 : 𝔉 ↦dg_Funct Ξ± 𝔄 𝔅 π”Š" by simp
    note 𝔑 = dg_Funct_is_arrD[OF this]
    show 
      "𝔑 ∈∘ set {[r, a, b]∘ | r a b. r βŠ†βˆ˜ 𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB ∧ a ∈∘ A ∧ b ∈∘ B}"
    proof(intro in_set_CollectI small exI conjI)
      show "𝔑 =
        [
          ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTMap⦈,
          cf_map (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTDom⦈),
          cf_map (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTCod⦈)
        ]∘"
        by (rule 𝔑(2)[unfolded ntcf_arrow_def])
      interpret 𝔑: is_tm_ntcf Ξ± 
        𝔄 𝔅 
        β€Ήcf_of_cf_map 𝔄 𝔅 𝔉› β€Ήcf_of_cf_map 𝔄 𝔅 π”Šβ€Ί 
        β€Ήntcf_of_ntcf_arrow 𝔄 𝔅 𝔑›
        rewrites "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTMap⦈ = 𝔑⦇NTMap⦈"
          and "cf_of_cf_map 𝔄 𝔅 𝔉⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
          and "cf_of_cf_map 𝔄 𝔅 π”Šβ¦‡ObjMap⦈ = π”Šβ¦‡ObjMap⦈"
        by
          (
            rule 𝔑(1), 
            unfold ntcf_of_ntcf_arrow_components cf_of_cf_map_components
          ) 
          simp_all
      show "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTMap⦈ βŠ†βˆ˜ 𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB"
      proof(intro vsubsetI, unfold ntcf_of_ntcf_arrow_components)
        fix af assume prems'': "af ∈∘ 𝔑⦇NTMap⦈"
        then obtain a f where af_def: "af = ⟨a, f⟩" 
          and a: "a ∈∘ 𝔄⦇Obj⦈"
          and f: "f ∈∘ β„›βˆ˜ (𝔑⦇NTMap⦈)" 
          by (elim 𝔑.NTMap.vbrelation_vinE)
        from prems'' have f_def: "f = 𝔑⦇NTMapβ¦ˆβ¦‡a⦈" 
          unfolding af_def 𝔑.NTMap.vsv_ex1_app1[OF a] .
        have 𝔑a: "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
          by (rule 𝔑.ntcf_NTMap_is_arr[OF a])
        have "f ∈∘ Hom_AB"
          unfolding f_def Hom_AB_def ARs_def BRs_def
        proof(intro vifunionI, unfold in_Hom_iff)
          show "𝔉 ∈∘ A" by (intro 𝔉)
          from a show "𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ∈∘ β„›βˆ˜ (𝔉⦇ObjMap⦈)" 
            by (metis 𝔑.NTDom.ObjMap.vdomain_atD 𝔑.NTDom.cf_ObjMap_vdomain)
          show "π”Š ∈∘ B" by (intro π”Š)
          from a show "π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ∈∘ β„›βˆ˜ (π”Šβ¦‡ObjMap⦈)" 
            by (metis 𝔑.NTCod.ObjMap.vdomain_atD 𝔑.NTCod.cf_ObjMap_vdomain)
          show "𝔑⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈" by (intro 𝔑a)
        qed
        with a show "af ∈∘ 𝔄⦇Obj⦈ Γ—βˆ˜ Hom_AB" unfolding af_def f_def by simp
      qed
      show "cf_map (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTDom⦈) ∈∘ A"
        unfolding 𝔑.ntcf_NTDom 𝔑(3)[symmetric] by (rule 𝔉)
      show "cf_map (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑⦇NTCod⦈) ∈∘ B"
        unfolding 𝔑.ntcf_NTCod 𝔑(4)[symmetric] by (rule π”Š)
    qed
  qed
  ultimately show "(β‹ƒβˆ˜a∈∘A. β‹ƒβˆ˜b∈∘B. Hom (dg_Funct Ξ± 𝔄 𝔅) a b) ∈∘ Vset Ξ±"
    by blast
qed (unfold dg_Funct_components, auto)


subsubsectionβ€Ήβ€ΉFunctβ€Ί is a subdigraph of β€ΉFUNCTβ€Ίβ€Ί

lemma (in 𝒡) subdigraph_dg_Funct_dg_FUNCT:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "tiny_category Ξ± 𝔄" and "category Ξ± 𝔅"
  shows "dg_Funct Ξ± 𝔄 𝔅 βŠ†DGΞ² dg_FUNCT Ξ± 𝔄 𝔅"
proof(intro subdigraphI, unfold dg_FUNCT_components(1) dg_Funct_components(1))
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  show "digraph Ξ² (dg_Funct Ξ± 𝔄 𝔅)"
    by (intro digraph.dg_digraph_if_ge_Limit[OF digraph_dg_Funct] assms)
  from assms show "digraph Ξ² (dg_FUNCT Ξ± 𝔄 𝔅)"    
    by (cs_concl cs_intro: dg_small_cs_intros tiny_digraph_dg_FUNCT)
  show "𝔉 ∈∘ cf_maps Ξ± 𝔄 𝔅" if "𝔉 ∈∘ tm_cf_maps Ξ± 𝔄 𝔅" for 𝔉
    using that by (cs_concl cs_intro: dg_FUNCT_cs_intros tm_cf_maps_in_cf_maps)
  show "𝔑 : 𝔉 ↦dg_FUNCT Ξ± 𝔄 𝔅 π”Š" if "𝔑 : 𝔉 ↦dg_Funct Ξ± 𝔄 𝔅 π”Š" 
    for 𝔑 𝔉 π”Š
  proof-
    note f = dg_Funct_is_arrD[OF that]
    from f(1) show ?thesis
      by (subst f(2), use nothing in β€Ήsubst f(3), subst f(4)β€Ί)
        (cs_concl cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros)
  qed
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_SMC_FUNCT

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉFUNCTβ€Ί and β€ΉFunctβ€Ί as semicategories\label{sec:smc_FUNCT}β€Ί
theory CZH_SMC_FUNCT
  imports 
    CZH_DG_FUNCT
    CZH_Foundations.CZH_SMC_Subsemicategory
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The subsection presents the theory of the semicategories of β€ΉΞ±β€Ί-functors
between two β€ΉΞ±β€Ί-categories.
It continues the development that was initiated in section
\ref{sec:dg_FUNCT}.
A general reference for this section is Chapter II-4 in 
\cite{mac_lane_categories_2010}.
β€Ί

named_theorems smc_FUNCT_cs_simps
named_theorems smc_FUNCT_cs_intros

lemmas [smc_FUNCT_cs_simps] = cat_map_cs_simps
lemmas [smc_FUNCT_cs_intros] =  cat_map_cs_intros



subsectionβ€Ήβ€ΉFUNCTβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition smc_FUNCT :: "V β‡’ V β‡’ V β‡’ V"
  where "smc_FUNCT Ξ± 𝔄 𝔅 =
    [
      cf_maps Ξ± 𝔄 𝔅,
      ntcf_arrows Ξ± 𝔄 𝔅,
      (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈),
      (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈),
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_FUNCT Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ)
    ]∘"
                     

textβ€ΉComponents.β€Ί

lemma smc_FUNCT_components:
  shows "smc_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈ = cf_maps Ξ± 𝔄 𝔅"
    and "smc_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈ = ntcf_arrows Ξ± 𝔄 𝔅"
    and "smc_FUNCT Ξ± 𝔄 𝔅⦇Dom⦈ = (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈)"
    and "smc_FUNCT Ξ± 𝔄 𝔅⦇Cod⦈ = (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)"
    and "smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈ =
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_FUNCT Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ)"
  unfolding smc_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma smc_dg_FUNCT: "smc_dg (smc_FUNCT Ξ± 𝔄 𝔅) = dg_FUNCT Ξ± 𝔄 𝔅"
proof(rule vsv_eqI)
  show "vsv (smc_dg (smc_FUNCT Ξ± 𝔄 𝔅))" unfolding smc_dg_def by auto
  show "vsv (dg_FUNCT Ξ± 𝔄 𝔅)" unfolding dg_FUNCT_def by auto
  have dom_lhs: "π’Ÿβˆ˜ (smc_dg (smc_FUNCT Ξ± 𝔄 𝔅)) = 4β„•" 
    unfolding smc_dg_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (dg_FUNCT Ξ± 𝔄 𝔅) = 4β„•"
    unfolding dg_FUNCT_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (smc_dg (smc_FUNCT Ξ± 𝔄 𝔅)) = π’Ÿβˆ˜ (dg_FUNCT Ξ± 𝔄 𝔅)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (smc_dg (smc_FUNCT Ξ± 𝔄 𝔅)) ⟹ 
    smc_dg (smc_FUNCT Ξ± 𝔄 𝔅)⦇a⦈ = dg_FUNCT Ξ± 𝔄 𝔅⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral,
        unfold smc_dg_def dg_field_simps smc_FUNCT_def dg_FUNCT_def
      )
      (auto simp: nat_omega_simps)
qed

context is_ntcf
begin

lemmas_with [folded smc_dg_FUNCT, unfolded slicing_simps]: 
  smc_FUNCT_Dom_app = dg_FUNCT_Dom_app
  and smc_FUNCT_Cod_app = dg_FUNCT_Cod_app

end

lemmas [smc_FUNCT_cs_simps] = 
  is_ntcf.smc_FUNCT_Dom_app
  is_ntcf.smc_FUNCT_Cod_app

lemmas_with [folded smc_dg_FUNCT, unfolded slicing_simps]: 
  smc_FUNCT_Dom_vsv[intro] = dg_FUNCT_Dom_vsv
  and smc_FUNCT_Dom_vdomain[smc_FUNCT_cs_simps] = dg_FUNCT_Dom_vdomain
  and smc_FUNCT_Cod_vsv[intro] = dg_FUNCT_Cod_vsv
  and smc_FUNCT_Cod_vdomain[smc_FUNCT_cs_simps] = dg_FUNCT_Cod_vdomain
  and smc_FUNCT_Dom_vrange = dg_FUNCT_Dom_vrange
  and smc_FUNCT_Cod_vrange = dg_FUNCT_Cod_vrange
  and smc_FUNCT_is_arrI = dg_FUNCT_is_arrI
  and smc_FUNCT_is_arrI'[smc_FUNCT_cs_intros] = dg_FUNCT_is_arrI'
  and smc_FUNCT_is_arrD = dg_FUNCT_is_arrD
  and smc_FUNCT_is_arrE[elim] = dg_FUNCT_is_arrE



subsubsectionβ€ΉComposable arrowsβ€Ί

lemma smc_FUNCT_composable_arrs_dg_FUNCT: 
  "composable_arrs (dg_FUNCT Ξ± 𝔄 𝔅) = composable_arrs (smc_FUNCT Ξ± 𝔄 𝔅)"
  unfolding composable_arrs_def smc_dg_FUNCT[symmetric] slicing_simps by auto

lemma smc_FUNCT_Comp: 
  "smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈ =
    (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (smc_FUNCT Ξ± 𝔄 𝔅). π”Šπ”‰β¦‡0⦈ βˆ™NTCF𝔄,𝔅 π”Šπ”‰β¦‡1β„•β¦ˆ)"
  unfolding smc_FUNCT_components smc_FUNCT_composable_arrs_dg_FUNCT ..


subsubsectionβ€ΉCompositionβ€Ί

lemma smc_FUNCT_Comp_vsv[intro]: "vsv (smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈)" 
  unfolding smc_FUNCT_Comp by simp

lemma smc_FUNCT_Comp_vdomain:
  "π’Ÿβˆ˜ (smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈) = composable_arrs (smc_FUNCT Ξ± 𝔄 𝔅)" 
  unfolding smc_FUNCT_Comp by auto

lemma smc_FUNCT_Comp_app[smc_FUNCT_cs_simps]:
  assumes "𝔐 : π”Š ↦smc_FUNCT Ξ± 𝔄 𝔅 β„Œ" and "𝔑 : 𝔉 ↦smc_FUNCT Ξ± 𝔄 𝔅 π”Š"
  shows "𝔐 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑 = 𝔐 βˆ™NTCF𝔄,𝔅 𝔑"
proof-
  from assms have "[𝔐, 𝔑]∘ ∈∘ composable_arrs (smc_FUNCT Ξ± 𝔄 𝔅)" 
    by (auto intro: smc_cs_intros)
  then show "𝔐 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑 = 𝔐 βˆ™NTCF𝔄,𝔅 𝔑"
    unfolding smc_FUNCT_Comp by (simp add: nat_omega_simps)
qed

lemma smc_FUNCT_Comp_vrange: "β„›βˆ˜ (smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈) βŠ†βˆ˜ ntcf_arrows Ξ± 𝔄 𝔅"
proof(rule vsubsetI)
  fix 𝔏 assume prems: "𝔏 ∈∘ β„›βˆ˜ (smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈)"
  then obtain 𝔐𝔑
    where 𝔏_def: "𝔏 = smc_FUNCT Ξ± 𝔄 𝔅⦇Compβ¦ˆβ¦‡π”π”‘β¦ˆ" 
      and "𝔐𝔑 ∈∘ π’Ÿβˆ˜ (smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈)"
    unfolding smc_FUNCT_components by (auto intro: smc_cs_intros)
  then obtain 𝔐 𝔑 𝔉 π”Š β„Œ 
    where "𝔐𝔑 = [𝔐, 𝔑]∘" 
      and 𝔐: "𝔐 : π”Š ↦smc_FUNCT Ξ± 𝔄 𝔅 β„Œ" 
      and 𝔑: "𝔑 : 𝔉 ↦smc_FUNCT Ξ± 𝔄 𝔅 π”Š"
    by (auto simp: smc_FUNCT_Comp_vdomain) 
  with 𝔏_def have 𝔏_def': "𝔏 = 𝔐 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑" by simp
  note 𝔐 = smc_FUNCT_is_arrD[OF 𝔐]
    and 𝔑 = smc_FUNCT_is_arrD[OF 𝔑]
  from 𝔐(1) 𝔑(1) show "𝔏 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅" 
    unfolding 𝔏_def'
    by (subst 𝔐(2), subst 𝔑(2), remdups)
      (
        cs_concl 
          cs_simp: smc_FUNCT_cs_simps cs_intro: cat_cs_intros smc_FUNCT_cs_intros
      )
qed


subsubsectionβ€Ήβ€ΉFUNCTβ€Ί is a semicategoryβ€Ί

lemma (in 𝒡) tiny_semicategory_smc_FUNCT: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_semicategory Ξ² (smc_FUNCT Ξ± 𝔄 𝔅)"
proof(intro tiny_semicategoryI)
  show "vfsequence (smc_FUNCT Ξ± 𝔄 𝔅)" by (simp add: smc_FUNCT_def)
  show "vcard (smc_FUNCT Ξ± 𝔄 𝔅) = 5β„•"
    unfolding smc_FUNCT_def by (simp add: nat_omega_simps)
  show "(𝔐𝔑 ∈∘ π’Ÿβˆ˜ (smc_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈)) =
    (
      βˆƒπ” 𝔑 π”Š β„Œ 𝔉.
        𝔐𝔑 = [𝔐, 𝔑]∘ ∧
        𝔐 : π”Š ↦smc_FUNCT Ξ± 𝔄 𝔅 β„Œ ∧
        𝔑 : 𝔉 ↦smc_FUNCT Ξ± 𝔄 𝔅 π”Š
    )"
    for 𝔐𝔑 
    unfolding smc_FUNCT_Comp by (auto intro: smc_cs_intros)
  show Comp_is_arr: "𝔐 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑 : 𝔉 ↦smc_FUNCT Ξ± 𝔄 𝔅 β„Œ"
    if "𝔐 : π”Š ↦smc_FUNCT Ξ± 𝔄 𝔅 β„Œ" and "𝔑 : 𝔉 ↦smc_FUNCT Ξ± 𝔄 𝔅 π”Š"
    for 𝔐 π”Š β„Œ 𝔑 𝔉
  proof-
    note g = smc_FUNCT_is_arrD[OF that(1)]
    note f = smc_FUNCT_is_arrD[OF that(2)]
    from g(1) f(1) show "𝔐 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑 : 𝔉 ↦smc_FUNCT Ξ± 𝔄 𝔅 β„Œ"
      by (subst g(2), subst g(4), subst f(2), subst f(3), remdups)
        (
          cs_concl 
            cs_simp: smc_FUNCT_cs_simps
            cs_intro: smc_FUNCT_cs_intros cat_cs_intros
        )
  qed
  fix 𝔏 β„Œ π”Ž 𝔐 π”Š 𝔑 𝔉
  assume prems:
    "𝔏 : β„Œ ↦smc_FUNCT Ξ± 𝔄 𝔅 π”Ž"
    "𝔐 : π”Š ↦smc_FUNCT Ξ± 𝔄 𝔅 β„Œ"
    "𝔑 : 𝔉 ↦smc_FUNCT Ξ± 𝔄 𝔅 π”Š"
  note 𝔏 = smc_FUNCT_is_arrD[OF prems(1)]
  note 𝔐 = smc_FUNCT_is_arrD[OF prems(2)]
  note 𝔑 = smc_FUNCT_is_arrD[OF prems(3)]
  from 𝔏(1) 𝔐(1) 𝔑(1) show 
    "(𝔏 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔐) ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑 =
      𝔏 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 (𝔐 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑)"    
    by (subst (1 2) 𝔏(2), subst (1 2) 𝔐(2), subst (1 2) 𝔑(2), remdups)
      (
        cs_concl 
          cs_simp: smc_FUNCT_cs_simps cat_cs_simps 
          cs_intro: smc_FUNCT_cs_intros cat_cs_intros
      )
qed 
  (
    simp_all add: 
      assms 
      smc_dg_FUNCT 
      smc_FUNCT_components 
      tiny_digraph_dg_FUNCT[OF assms(1,2)]  
  ) 



subsectionβ€Ήβ€ΉFunctβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition smc_Funct :: "V β‡’ V β‡’ V β‡’ V"
  where "smc_Funct Ξ± 𝔄 𝔅 =
    [
      tm_cf_maps Ξ± 𝔄 𝔅,
      tm_ntcf_arrows Ξ± 𝔄 𝔅,
      (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈),
      (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈),
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_Funct Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ)
    ]∘"


textβ€ΉComponents.β€Ί

lemma smc_Funct_components: 
  shows "smc_Funct Ξ± 𝔄 𝔅⦇Obj⦈ = tm_cf_maps Ξ± 𝔄 𝔅"
    and "smc_Funct Ξ± 𝔄 𝔅⦇Arr⦈ = tm_ntcf_arrows Ξ± 𝔄 𝔅"
    and "smc_Funct Ξ± 𝔄 𝔅⦇Dom⦈ = (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈)"
    and "smc_Funct Ξ± 𝔄 𝔅⦇Cod⦈ = (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)"
    and "smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈ =
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_Funct Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ)"
  unfolding smc_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma smc_dg_Funct: "smc_dg (smc_Funct Ξ± 𝔄 𝔅) = dg_Funct Ξ± 𝔄 𝔅"
proof(rule vsv_eqI)
  show "vsv (smc_dg (smc_Funct Ξ± 𝔄 𝔅))" unfolding smc_dg_def by auto
  show "vsv (dg_Funct Ξ± 𝔄 𝔅)" unfolding dg_Funct_def by auto
  have dom_lhs: "π’Ÿβˆ˜ (smc_dg (smc_Funct Ξ± 𝔄 𝔅)) = 4β„•" 
    unfolding smc_dg_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (dg_Funct Ξ± 𝔄 𝔅) = 4β„•"
    unfolding dg_Funct_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (smc_dg (smc_Funct Ξ± 𝔄 𝔅)) = π’Ÿβˆ˜ (dg_Funct Ξ± 𝔄 𝔅)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (smc_dg (smc_Funct Ξ± 𝔄 𝔅)) ⟹
    smc_dg (smc_Funct Ξ± 𝔄 𝔅)⦇a⦈ = dg_Funct Ξ± 𝔄 𝔅⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral,
        unfold smc_dg_def dg_field_simps smc_Funct_def dg_Funct_def
      )
      (auto simp: nat_omega_simps)
qed

context is_tm_ntcf
begin

lemmas_with [folded smc_dg_Funct, unfolded slicing_simps]: 
  smc_Funct_Dom_app = dg_Funct_Dom_app
  and smc_Funct_Cod_app = dg_Funct_Cod_app

end

lemmas [smc_FUNCT_cs_simps] = 
  is_tm_ntcf.smc_Funct_Dom_app
  is_tm_ntcf.smc_Funct_Cod_app

lemmas_with [folded smc_dg_Funct, unfolded slicing_simps]: 
  smc_Funct_Dom_vsv[intro] = dg_Funct_Dom_vsv
  and smc_Funct_Dom_vdomain[smc_FUNCT_cs_simps] = dg_Funct_Dom_vdomain
  and smc_Funct_Cod_vsv[intro] = dg_Funct_Cod_vsv
  and smc_Funct_Cod_vdomain[smc_FUNCT_cs_simps] = dg_Funct_Cod_vdomain
  and smc_Funct_Dom_vrange = dg_Funct_Dom_vrange
  and smc_Funct_Cod_vrange = dg_Funct_Cod_vrange
  and smc_Funct_is_arrI = dg_Funct_is_arrI
  and smc_Funct_is_arrI'[smc_FUNCT_cs_intros] = dg_Funct_is_arrI'
  and smc_Funct_is_arrD = dg_Funct_is_arrD
  and smc_Funct_is_arrE[elim] = dg_Funct_is_arrE


subsubsectionβ€ΉComposable arrowsβ€Ί

lemma smc_Funct_composable_arrs_dg_FUNCT: 
  "composable_arrs (dg_Funct Ξ± 𝔄 𝔅) = composable_arrs (smc_Funct Ξ± 𝔄 𝔅)"
  unfolding composable_arrs_def smc_dg_Funct[symmetric] slicing_simps by auto

lemma smc_Funct_Comp: 
  "smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈ =
    (Ξ»π”Šπ”‰βˆˆβˆ˜composable_arrs (smc_Funct Ξ± 𝔄 𝔅). π”Šπ”‰β¦‡0⦈ βˆ™NTCF𝔄,𝔅 π”Šπ”‰β¦‡1β„•β¦ˆ)"
  unfolding smc_Funct_components smc_Funct_composable_arrs_dg_FUNCT ..


subsubsectionβ€ΉCompositionβ€Ί

lemma smc_Funct_Comp_vsv[intro]: "vsv (smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈)" 
  unfolding smc_Funct_Comp by simp

lemma smc_Funct_Comp_vdomain:
  "π’Ÿβˆ˜ (smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈) = composable_arrs (smc_Funct Ξ± 𝔄 𝔅)" 
  unfolding smc_Funct_Comp by auto

lemma smc_Funct_Comp_app[smc_FUNCT_cs_simps]:
  assumes "𝔐 : π”Š ↦smc_Funct Ξ± 𝔄 𝔅 β„Œ" and "𝔑 : 𝔉 ↦smc_Funct Ξ± 𝔄 𝔅 π”Š"
  shows "𝔐 ∘Asmc_Funct Ξ± 𝔄 𝔅 𝔑 = 𝔐 βˆ™NTCF𝔄,𝔅 𝔑"
proof-
  from assms have "[𝔐, 𝔑]∘ ∈∘ composable_arrs (smc_Funct Ξ± 𝔄 𝔅)" 
    by (auto intro: smc_cs_intros)
  then show "𝔐 ∘Asmc_Funct Ξ± 𝔄 𝔅 𝔑 = 𝔐 βˆ™NTCF𝔄,𝔅 𝔑"
    unfolding smc_Funct_Comp by (simp add: nat_omega_simps)
qed

lemma smc_Funct_Comp_vrange: 
  assumes "category Ξ± 𝔅"
  shows "β„›βˆ˜ (smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈) βŠ†βˆ˜ tm_ntcf_arrows Ξ± 𝔄 𝔅"
proof(rule vsubsetI)
  fix 𝔏 assume "𝔏 ∈∘ β„›βˆ˜ (smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈)"
  then obtain 𝔐𝔑
    where 𝔏_def: "𝔏 = smc_Funct Ξ± 𝔄 𝔅⦇Compβ¦ˆβ¦‡π”π”‘β¦ˆ" 
      and "𝔐𝔑 ∈∘ π’Ÿβˆ˜ (smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈)"
    unfolding smc_Funct_components 
    by (auto intro: smc_cs_intros)
  then obtain 𝔐 𝔑 𝔉 π”Š β„Œ 
    where "𝔐𝔑 = [𝔐, 𝔑]∘" 
      and 𝔐: "𝔐 : π”Š ↦smc_Funct Ξ± 𝔄 𝔅 β„Œ" 
      and 𝔑: "𝔑 : 𝔉 ↦smc_Funct Ξ± 𝔄 𝔅 π”Š"
    by (auto simp: smc_Funct_Comp_vdomain) 
  with 𝔏_def have 𝔏_def': "𝔏 = 𝔐 ∘Asmc_Funct Ξ± 𝔄 𝔅 𝔑" by simp
  note 𝔐 = smc_Funct_is_arrD[OF 𝔐]
    and 𝔑 = smc_Funct_is_arrD[OF 𝔑]
  from assms 𝔐(1) 𝔑(1) show "𝔏 ∈∘ tm_ntcf_arrows Ξ± 𝔄 𝔅" 
    unfolding 𝔏_def'
    by (subst 𝔐(2), use nothing in β€Ήsubst 𝔑(2)β€Ί)
      (
        cs_concl 
          cs_simp: smc_FUNCT_cs_simps 
          cs_intro: smc_FUNCT_cs_intros cat_small_cs_intros
      )
qed


subsubsectionβ€Ήβ€ΉFunctβ€Ί is a semicategoryβ€Ί

lemma semicategory_smc_Funct:
  assumes "tiny_category Ξ± 𝔄" and "category Ξ± 𝔅"
  shows "semicategory Ξ± (smc_Funct Ξ± 𝔄 𝔅)" (is β€Ήsemicategory Ξ± ?Functβ€Ί)
proof-
  interpret tiny_category Ξ± 𝔄 by (rule assms(1))
  show ?thesis
  proof(intro semicategoryI)
    show "vfsequence ?Funct" by (simp add: smc_Funct_def)
    show "vcard ?Funct = 5β„•" 
      unfolding smc_Funct_def by (simp add: nat_omega_simps)
    show "(𝔐𝔑 ∈∘ π’Ÿβˆ˜ (smc_Funct Ξ± 𝔄 𝔅⦇Comp⦈)) =
      (βˆƒπ” 𝔑 π”Š β„Œ 𝔉. 𝔐𝔑 = [𝔐, 𝔑]∘ ∧ 𝔐 : π”Š ↦?Funct β„Œ ∧ 𝔑 : 𝔉 ↦?Funct π”Š)"
      for 𝔐𝔑 
      unfolding smc_Funct_Comp by (auto intro: smc_cs_intros)
    show Comp_is_arr: "𝔐 ∘A?Funct 𝔑 : 𝔉 ↦?Funct β„Œ"
      if "𝔐 : π”Š ↦?Funct β„Œ" and "𝔑 : 𝔉 ↦?Funct π”Š"
      for 𝔐 π”Š β„Œ 𝔑 𝔉
    proof-
      note 𝔐 = smc_Funct_is_arrD[OF that(1)]
      note 𝔑 = smc_Funct_is_arrD[OF that(2)]
      from assms 𝔐(1) 𝔑(1) show 
        "𝔐 ∘A?Funct 𝔑 : 𝔉 ↦?Funct β„Œ"
        by (subst 𝔐(2), use nothing in β€Ήsubst 𝔐(4), subst 𝔑(2), subst 𝔑(3)β€Ί)
          (
            cs_concl 
              cs_simp: smc_FUNCT_cs_simps 
              cs_intro: smc_FUNCT_cs_intros cat_small_cs_intros
          )
    qed
    show "𝔏 ∘A?Funct 𝔐 ∘A?Funct 𝔑 = 𝔏 ∘A?Funct (𝔐 ∘A?Funct 𝔑)"
      if "𝔏 : β„Œ ↦?Funct π”Ž" "𝔐 : π”Š ↦?Funct β„Œ" "𝔑 : 𝔉 ↦?Funct π”Š"
      for 𝔏 β„Œ π”Ž 𝔐 π”Š 𝔑 𝔉
    proof-
      note 𝔏 = smc_Funct_is_arrD[OF that(1)]
      note 𝔐 = smc_Funct_is_arrD[OF that(2)]
      note 𝔑 = smc_Funct_is_arrD[OF that(3)]
      from assms 𝔏(1) 𝔐(1) 𝔑(1) show
        "(𝔏 ∘A?Funct 𝔐) ∘A?Funct 𝔑 = 𝔏 ∘A?Funct (𝔐 ∘A?Funct 𝔑)"    
        by 
          (
            subst (1 2) 𝔏(2),
            use nothing in β€Ήsubst (1 2) 𝔐(2), subst (1 2) 𝔑(2)β€Ί
          )
          (
            cs_concl
              cs_simp: smc_FUNCT_cs_simps cat_cs_simps cat_small_cs_simps 
              cs_intro: smc_FUNCT_cs_intros cat_cs_intros cat_small_cs_intros
          )
    qed
  qed (auto simp: assms smc_dg_Funct smc_Funct_components digraph_dg_Funct)
qed


subsubsectionβ€Ήβ€ΉFunctβ€Ί is a subsemicategory of β€ΉFUNCTβ€Ίβ€Ί

lemma subsemicategory_smc_Funct_smc_FUNCT:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "tiny_category Ξ± 𝔄" and "category Ξ± 𝔅"
  shows "smc_Funct Ξ± 𝔄 𝔅 βŠ†SMCΞ² smc_FUNCT Ξ± 𝔄 𝔅"
proof(intro subsemicategoryI, unfold smc_dg_FUNCT smc_dg_Funct)
  interpret category Ξ± 𝔅 by (rule assms(4))
  interpret smc_Funct: semicategory Ξ± β€Ήsmc_Funct Ξ± 𝔄 𝔅›
    by (rule semicategory_smc_Funct[OF assms(3,4)])
  show "semicategory Ξ² (smc_Funct Ξ± 𝔄 𝔅)"
    by (rule semicategory.smc_semicategory_if_ge_Limit[OF _ assms(1,2)]) 
      (auto simp: smc_cs_simps intro: smc_cs_intros)
  from assms show "semicategory Ξ² (smc_FUNCT Ξ± 𝔄 𝔅)"
    by 
      (
        cs_concl
          cs_intro: smc_small_cs_intros tiny_semicategory_smc_FUNCT
      )
  show "dg_Funct Ξ± 𝔄 𝔅 βŠ†DGΞ² dg_FUNCT Ξ± 𝔄 𝔅"
    by (rule subdigraph_dg_Funct_dg_FUNCT[OF assms])
  show "𝔐 ∘Asmc_Funct Ξ± 𝔄 𝔅 𝔑 = 𝔐 ∘Asmc_FUNCT Ξ± 𝔄 𝔅 𝔑"
    if "𝔐 : π”Š ↦smc_Funct Ξ± 𝔄 𝔅 β„Œ" and "𝔑 : 𝔉 ↦smc_Funct Ξ± 𝔄 𝔅 π”Š"
    for π”Š β„Œ 𝔐 𝔉 𝔑
  proof-
    note 𝔐 = smc_Funct_is_arrD[OF that(1)]
    note 𝔑 = smc_Funct_is_arrD[OF that(2)]
    from 𝔐(1) 𝔑(1) show ?thesis
      by (subst (1 2) 𝔐(2), use nothing in β€Ήsubst (1 2) 𝔑(2)β€Ί)
        (
          cs_concl 
            cs_simp: smc_FUNCT_cs_simps cat_small_cs_simps 
            cs_intro: smc_FUNCT_cs_intros cat_small_cs_intros
        )
  qed
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_FUNCT

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉFUNCTβ€Ί and β€ΉFunctβ€Ίβ€Ί
theory CZH_ECAT_FUNCT
  imports
    CZH_SMC_FUNCT
    CZH_ECAT_Subcategory
    CZH_ECAT_NTCF
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The subsection presents the theory of the categories of β€ΉΞ±β€Ί-functors
between two β€ΉΞ±β€Ί-categories.
It continues the development that was initiated in sections 
\ref{sec:dg_FUNCT} and \ref{sec:smc_FUNCT}.
A general reference for this section is Chapter II-4 in 
\cite{mac_lane_categories_2010}.
β€Ί

named_theorems cat_FUNCT_cs_simps
named_theorems cat_FUNCT_cs_intros

lemmas [cat_FUNCT_cs_simps] = cat_map_cs_simps
lemmas [cat_FUNCT_cs_intros] = cat_map_cs_intros



subsectionβ€Ήβ€ΉFUNCTβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_FUNCT :: "V β‡’ V β‡’ V β‡’ V"
  where "cat_FUNCT Ξ± 𝔄 𝔅 =
    [
      cf_maps Ξ± 𝔄 𝔅,
      ntcf_arrows Ξ± 𝔄 𝔅,
      (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈),
      (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈),
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_FUNCT Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ),
      (Ξ»π”‰βˆˆβˆ˜cf_maps Ξ± 𝔄 𝔅. ntcf_arrow_id 𝔄 𝔅 𝔉)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_FUNCT_components:
  shows [cat_FUNCT_cs_simps]: "cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈ = cf_maps Ξ± 𝔄 𝔅"
    and "cat_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈ = ntcf_arrows Ξ± 𝔄 𝔅"
    and "cat_FUNCT Ξ± 𝔄 𝔅⦇Dom⦈ = (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈)"
    and "cat_FUNCT Ξ± 𝔄 𝔅⦇Cod⦈ = (Ξ»π”‘βˆˆβˆ˜ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)"
    and "cat_FUNCT Ξ± 𝔄 𝔅⦇Comp⦈ =
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_FUNCT Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ)"
    and "cat_FUNCT Ξ± 𝔄 𝔅⦇CId⦈ = (Ξ»π”‰βˆˆβˆ˜cf_maps Ξ± 𝔄 𝔅. ntcf_arrow_id 𝔄 𝔅 𝔉)"
  unfolding cat_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_FUNCT: "cat_smc (cat_FUNCT Ξ± 𝔄 𝔅) = smc_FUNCT Ξ± 𝔄 𝔅"
proof(rule vsv_eqI)
  show "vsv (cat_smc (cat_FUNCT Ξ± 𝔄 𝔅))" unfolding cat_smc_def by auto
  show "vsv (smc_FUNCT Ξ± 𝔄 𝔅)" unfolding smc_FUNCT_def by auto
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_FUNCT Ξ± 𝔄 𝔅)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_FUNCT Ξ± 𝔄 𝔅) = 5β„•"
    unfolding smc_FUNCT_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_FUNCT Ξ± 𝔄 𝔅)) = π’Ÿβˆ˜ (smc_FUNCT Ξ± 𝔄 𝔅)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_FUNCT Ξ± 𝔄 𝔅)) ⟹
    cat_smc (cat_FUNCT Ξ± 𝔄 𝔅)⦇a⦈ = smc_FUNCT Ξ± 𝔄 𝔅⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        unfold cat_smc_def dg_field_simps cat_FUNCT_def smc_FUNCT_def
      )
      (auto simp: nat_omega_simps)
qed

context is_ntcf
begin

lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]: 
  cat_FUNCT_Dom_app = smc_FUNCT_Dom_app
  and cat_FUNCT_Cod_app = smc_FUNCT_Cod_app

end

lemmas [smc_FUNCT_cs_simps] = 
  is_ntcf.cat_FUNCT_Dom_app
  is_ntcf.cat_FUNCT_Cod_app

lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]: 
  cat_FUNCT_Dom_vsv[intro] = smc_FUNCT_Dom_vsv
  and cat_FUNCT_Dom_vdomain[cat_FUNCT_cs_simps] = smc_FUNCT_Dom_vdomain
  and cat_FUNCT_Cod_vsv[intro] = smc_FUNCT_Cod_vsv
  and cat_FUNCT_Cod_vdomain[cat_FUNCT_cs_simps] = smc_FUNCT_Cod_vdomain
  and cat_FUNCT_Dom_vrange = smc_FUNCT_Dom_vrange
  and cat_FUNCT_Cod_vrange = smc_FUNCT_Cod_vrange
  and cat_FUNCT_is_arrI = smc_FUNCT_is_arrI
  and cat_FUNCT_is_arrI'[cat_FUNCT_cs_intros] = smc_FUNCT_is_arrI'
  and cat_FUNCT_is_arrD = smc_FUNCT_is_arrD
  and cat_FUNCT_is_arrE[elim] = smc_FUNCT_is_arrE

lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]: 
  cat_FUNCT_Comp_app[cat_FUNCT_cs_simps] = smc_FUNCT_Comp_app


subsubsectionβ€ΉIdentityβ€Ί

mk_VLambda cat_FUNCT_components(6)
  |vsv cat_FUNCT_CId_vsv[cat_FUNCT_cs_intros]|
  |vdomain cat_FUNCT_CId_vdomain[cat_FUNCT_cs_simps]|
  |app cat_FUNCT_CId_app[cat_FUNCT_cs_simps]|

lemma smc_FUNCT_CId_vrange: "β„›βˆ˜ (cat_FUNCT Ξ± 𝔄 𝔅⦇CId⦈) βŠ†βˆ˜ ntcf_arrows Ξ± 𝔄 𝔅"
  unfolding cat_FUNCT_components
proof(rule vrange_VLambda_vsubset)
  fix x assume "x ∈∘ cf_maps Ξ± 𝔄 𝔅"
  then obtain 𝔉 where x_def: "x = cf_map 𝔉" and 𝔉: "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
    by clarsimp  
  then show "ntcf_arrow_id 𝔄 𝔅 x ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    unfolding x_def
    by 
      (
        cs_concl 
          cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
      )
qed



subsubsectionβ€Ή
The conversion of a natural transformation arrow 
to a natural transformation is a bijection
β€Ί

lemma bij_betw_ntcf_of_ntcf_arrow:
  "bij_betw
    (ntcf_of_ntcf_arrow 𝔄 𝔅)
    (elts (ntcf_arrows Ξ± 𝔄 𝔅))
    (elts (ntcfs Ξ± 𝔄 𝔅))"
proof(intro bij_betw_imageI inj_onI subset_antisym subsetI)
  fix 𝔐 𝔑 assume prems: 
    "𝔐 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    "𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔐 = ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑"
  from prems(1) obtain 𝔐' 𝔉 π”Š 
    where 𝔐_def: "𝔐 = ntcf_arrow 𝔐'" and 𝔐': "𝔐' : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  from prems(2) obtain 𝔑' 𝔉' π”Š' 
    where 𝔑_def: "𝔑 = ntcf_arrow 𝔑'" and 𝔑': "𝔑' : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  from prems(3) have "𝔐' = 𝔑'"
    unfolding 
      𝔐_def 
      𝔑_def  
      is_ntcf.ntcf_of_ntcf_arrow[OF 𝔐']
      is_ntcf.ntcf_of_ntcf_arrow[OF 𝔑']
    by simp
  then show "𝔐 = 𝔑" unfolding 𝔐_def 𝔑_def by auto
next
  fix 𝔐 assume 
    "𝔐 ∈ ntcf_of_ntcf_arrow 𝔄 𝔅 ` elts (ntcf_arrows Ξ± 𝔄 𝔅)"
  then obtain 𝔐' where 𝔐': "𝔐' ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    and 𝔐_def: "𝔐 = ntcf_of_ntcf_arrow 𝔄 𝔅 𝔐'"
    by auto  
  from 𝔐' obtain 𝔐'' 𝔉 π”Š
    where 𝔐'_def: "𝔐' = ntcf_arrow 𝔐''" 
      and 𝔐'': "𝔐'' : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by auto
  from 𝔐'' show "𝔐 ∈∘ ntcfs Ξ± 𝔄 𝔅"
    unfolding 𝔐_def 𝔐'_def is_ntcf.ntcf_of_ntcf_arrow[OF 𝔐''] by auto
next
  fix 𝔐 assume "𝔐 ∈∘ ntcfs Ξ± 𝔄 𝔅"
  then obtain 𝔉 π”Š where 𝔐: "𝔐 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" by clarsimp
  then have "𝔐 = ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔐)" 
    by (cs_concl cs_simp: cat_FUNCT_cs_simps)
  moreover from 𝔐 have "ntcf_arrow 𝔐 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    by (cs_concl cs_intro: cat_FUNCT_cs_intros)
  ultimately show "𝔐 ∈ ntcf_of_ntcf_arrow 𝔄 𝔅 ` elts (ntcf_arrows Ξ± 𝔄 𝔅)"
    by simp
qed

lemma bij_betw_ntcf_of_ntcf_arrow_Hom:
  assumes "𝔉 : 𝔄 ↦↦CΞ± 𝔅" and "π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "bij_betw
    (ntcf_of_ntcf_arrow 𝔄 𝔅)
    (elts (Hom (cat_FUNCT Ξ± 𝔄 𝔅) (cf_map 𝔉) (cf_map π”Š)))
    (elts (these_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š))"
proof-

  interpret 𝔉: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔄 𝔅 π”Š  by (rule assms(2))

  from assms have [cat_cs_simps]:
    "cf_of_cf_map 𝔄 𝔅 (cf_map 𝔉) = 𝔉"
    "cf_of_cf_map 𝔄 𝔅 (cf_map π”Š) = π”Š"
    by (cs_concl cs_simp: cat_FUNCT_cs_simps)+

  show ?thesis
  proof
    (
      rule bij_betw_subset[OF bij_betw_ntcf_of_ntcf_arrow];
      (intro subset_antisym subsetI)?;
      (unfold in_Hom_iff)?
    )
    fix 𝔑 assume prems: "𝔑 : cf_map 𝔉 ↦cat_FUNCT Ξ± 𝔄 𝔅 cf_map π”Š"  
    note 𝔑 = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
    from 𝔑(1) show "𝔑 ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
      by (subst 𝔑(2)) (cs_concl cs_intro: cat_FUNCT_cs_intros)  
  next
    fix 𝔑 assume 
      "𝔑 ∈ ntcf_of_ntcf_arrow 𝔄 𝔅 `
        elts (Hom (cat_FUNCT Ξ± 𝔄 𝔅) (cf_map 𝔉) (cf_map π”Š))"
    then obtain 𝔑' 
      where 𝔑': "𝔑' ∈∘ Hom (cat_FUNCT Ξ± 𝔄 𝔅) (cf_map 𝔉) (cf_map π”Š)"
        and 𝔑_def: "𝔑 = ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑'"
      by auto
    note 𝔑' = cat_FUNCT_is_arrD[
        OF 𝔑'[unfolded cat_cs_simps], unfolded cat_cs_simps
        ]
    from 𝔑'(1) show "𝔑 ∈∘ these_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š" unfolding 𝔑_def by simp
  next
    fix 𝔑 assume "𝔑 ∈∘ these_ntcfs Ξ± 𝔄 𝔅 𝔉 π”Š"
    then have 𝔑: "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅" by simp
    then have "𝔑 = ntcf_of_ntcf_arrow 𝔄 𝔅 (ntcf_arrow 𝔑)"
      by (cs_concl cs_simp: cat_FUNCT_cs_simps)  
    moreover from 𝔑 have
      "ntcf_arrow 𝔑 ∈∘ Hom (cat_FUNCT Ξ± 𝔄 𝔅) (cf_map 𝔉) (cf_map π”Š)"
      unfolding in_Hom_iff by (cs_concl cs_intro: cat_FUNCT_cs_intros)
    ultimately show 
      "𝔑 ∈ ntcf_of_ntcf_arrow 𝔄 𝔅 `
        elts (Hom (cat_FUNCT Ξ± 𝔄 𝔅) (cf_map 𝔉) (cf_map π”Š))"
      by simp
  qed

qed


subsubsectionβ€Ήβ€ΉFUNCTβ€Ί is a categoryβ€Ί

lemma (in 𝒡) tiny_category_cat_FUNCT[cat_FUNCT_cs_intros]: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "tiny_category Ξ² (cat_FUNCT Ξ± 𝔄 𝔅)" (is β€Ήtiny_category Ξ² ?FUNCTβ€Ί)
proof(intro tiny_categoryI)
  show "vfsequence ?FUNCT" unfolding cat_FUNCT_def by auto
  show "vcard ?FUNCT = 6β„•" 
    unfolding cat_FUNCT_def by (simp add: nat_omega_simps)
  from assms show "tiny_semicategory Ξ² (cat_smc ?FUNCT)"
    unfolding cat_smc_FUNCT 
    by (auto simp add: tiny_semicategory_smc_FUNCT)
  show CId_a: "?FUNCT⦇CIdβ¦ˆβ¦‡π”‰'⦈ : 𝔉' ↦?FUNCT 𝔉'" if "𝔉' ∈∘ ?FUNCT⦇Obj⦈" for 𝔉'
  proof-
    from that obtain 𝔉 where 𝔉'_def: "𝔉' = cf_map 𝔉" and 𝔉: "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
      unfolding cat_FUNCT_components by clarsimp 
    show ?thesis
      using that 𝔉
      unfolding cat_FUNCT_components(1) 𝔉'_def
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed
  show "?FUNCT⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ ∘A?FUNCT 𝔑 = 𝔑" if "𝔑 : 𝔉 ↦?FUNCT π”Š" for 𝔑 𝔉 π”Š
  proof-
    from that obtain 𝔑' 𝔉' π”Š' 
      where 𝔑': "𝔑' : 𝔉' ↦CF π”Š' : 𝔄 ↦↦CΞ± 𝔅"
        and 𝔑_def[cat_FUNCT_cs_simps]: "𝔑 = ntcf_arrow 𝔑'"
        and 𝔉_def[cat_FUNCT_cs_simps]: "𝔉 = cf_map 𝔉'"
        and π”Š_def[cat_FUNCT_cs_simps]: "π”Š = cf_map π”Š'"
      by auto
    from 𝔑' show "cat_FUNCT Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ ∘Acat_FUNCT Ξ± 𝔄 𝔅 𝔑 = 𝔑"
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps cat_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed 
  show "𝔑 ∘A?FUNCT ?FUNCT⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ = 𝔑" if "𝔑 : π”Š ↦?FUNCT β„Œ" for 𝔑 π”Š β„Œ
  proof-
    note 𝔑 = cat_FUNCT_is_arrD[OF that]
    from 𝔑(1) show "𝔑 ∘Acat_FUNCT Ξ± 𝔄 𝔅 cat_FUNCT Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ = 𝔑"
      by (subst (1 2) 𝔑(2), subst 𝔑(3), remdups) 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps cat_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed 
qed (simp_all add: assms cat_FUNCT_components)

lemmas (in 𝒡) [cat_FUNCT_cs_intros] = tiny_category_cat_FUNCT



subsubsectionβ€ΉIsomorphismβ€Ί

lemma (in 𝒡) cat_FUNCT_is_arr_isomorphismI: 
  assumes "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
  shows "ntcf_arrow 𝔑 : cf_map 𝔉 ↦isocat_FUNCT Ξ± 𝔄 𝔅 cf_map π”Š"
proof(intro is_arr_isomorphismI is_inverseI)
  interpret 𝔑: is_iso_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms)
  show is_arr_𝔑: "ntcf_arrow 𝔑 : cf_map 𝔉 ↦cat_FUNCT Ξ± 𝔄 𝔅 cf_map π”Š"
    by (simp add: assms cat_FUNCT_is_arrI is_iso_ntcf.axioms(1))
  interpret inv_𝔑: is_iso_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 β€Ήinv_ntcf 𝔑› 
    using CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF assms] by simp
  from assms show is_arr_inv_𝔑: 
    "ntcf_arrow (inv_ntcf 𝔑) : cf_map π”Š ↦cat_FUNCT Ξ± 𝔄 𝔅 cf_map 𝔉"
    by 
      (
        cs_concl cs_intro:
          ntcf_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  from assms show "ntcf_arrow 𝔑 : cf_map 𝔉 ↦cat_FUNCT Ξ± 𝔄 𝔅 cf_map π”Š" 
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms show 
    "ntcf_arrow (inv_ntcf 𝔑) ∘Acat_FUNCT Ξ± 𝔄 𝔅 ntcf_arrow 𝔑 = 
      cat_FUNCT Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡cf_map π”‰β¦ˆ"
    "ntcf_arrow 𝔑 ∘Acat_FUNCT Ξ± 𝔄 𝔅 ntcf_arrow (inv_ntcf 𝔑) = 
      cat_FUNCT Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡cf_map π”Šβ¦ˆ"
    by 
      (
        cs_concl 
          cs_simp: iso_ntcf_is_arr_isomorphism(2,3) cat_FUNCT_cs_simps
          cs_intro: ntcf_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )+
qed

lemma (in 𝒡) cat_FUNCT_is_arr_isomorphismI': 
  assumes "𝔑' = ntcf_arrow 𝔑" 
    and "𝔑 : 𝔉 ↦CF.iso π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "𝔉' = cf_map 𝔉"
    and "π”Š' = cf_map π”Š"
  shows "𝔑' : 𝔉' ↦isocat_FUNCT Ξ± 𝔄 𝔅 cf_map π”Š"
  using assms(2) unfolding assms(1,3,4) by (rule cat_FUNCT_is_arr_isomorphismI)

lemmas [cat_FUNCT_cs_intros] = 𝒡.cat_FUNCT_is_arr_isomorphismI'[rotated 2]

lemma (in 𝒡) cat_FUNCT_is_arr_isomorphismD:
  assumes "𝔑 : 𝔉 ↦isocat_FUNCT Ξ± 𝔄 𝔅 π”Š" (is ‹𝔑 : 𝔉 ↦iso?FUNCT π”Šβ€Ί)
  shows "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 :
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF.iso cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦CΞ± 𝔅" 
    and "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
proof-
  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have 𝒡β: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²"
    by (simp_all add: 𝒡_Ξ±_Ξ±Ο‰ 𝒡.intro 𝒡_Limit_Ξ±Ο‰ 𝒡_Ο‰_Ξ±Ο‰ Ξ²_def)
  interpret FUNCT: tiny_category Ξ² ?FUNCT 
    by (rule tiny_category_cat_FUNCT[OF 𝒡β Ξ±Ξ², of 𝔄 𝔅])
  have inv_𝔑: "𝔑¯C?FUNCT : π”Š ↦iso?FUNCT 𝔉"
    and inv_𝔑_𝔑: "𝔑¯C?FUNCT ∘A?FUNCT 𝔑 = ?FUNCT⦇CIdβ¦ˆβ¦‡π”‰β¦ˆ"
    and 𝔑_inv_𝔑: "𝔑 ∘A?FUNCT 𝔑¯C?FUNCT = ?FUNCT⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ"
    by 
      (
        intro 
          FUNCT.cat_the_inverse_is_arr_isomorphism[OF assms] 
          FUNCT.cat_the_inverse_Comp_CId[OF assms]
      )+
  from assms is_arr_isomorphismD inv_𝔑 
  have 𝔑_is_arr: "𝔑 : 𝔉 ↦cat_FUNCT Ξ± 𝔄 𝔅 π”Š" 
    and inv_𝔑_is_arr: "𝔑¯C?FUNCT : π”Š ↦cat_FUNCT Ξ± 𝔄 𝔅 𝔉"
    by auto
  note 𝔑_is_arr = cat_FUNCT_is_arrD[OF 𝔑_is_arr]
  note inv_𝔑_is_arr = cat_FUNCT_is_arrD[OF inv_𝔑_is_arr]
  let ?𝔑 = β€Ήntcf_of_ntcf_arrow 𝔄 𝔅 𝔑›
    and ?inv_𝔑 = β€Ήntcf_of_ntcf_arrow 𝔄 𝔅 (𝔑¯Ccat_FUNCT Ξ± 𝔄 𝔅)β€Ί
  from inv_𝔑_𝔑 𝔑_is_arr(1) inv_𝔑_is_arr(1) have inv_𝔑_𝔑:
    "?inv_𝔑 βˆ™NTCF ?𝔑 = ntcf_id (cf_of_cf_map 𝔄 𝔅 𝔉)"
    by  
      (
        subst (asm) inv_𝔑_is_arr(2), 
        use nothing in β€Ήsubst (asm) (2) 𝔑_is_arr(2), subst (asm) 𝔑_is_arr(3)β€Ί
      )
      (
        cs_prems
          cs_simp: cat_FUNCT_cs_simps
          cs_intro: cat_FUNCT_cs_intros cat_cs_intros
      )
  from 𝔑_inv_𝔑 inv_𝔑_is_arr(1) 𝔑_is_arr(1) have 𝔑_inv_𝔑:
    "?𝔑 βˆ™NTCF ?inv_𝔑 = ntcf_id (cf_of_cf_map 𝔄 𝔅 π”Š)"
    by  
      (
        subst (asm) inv_𝔑_is_arr(2), 
        use nothing in β€Ήsubst (asm) 𝔑_is_arr(2), subst (asm) 𝔑_is_arr(4)β€Ί
      )
      (
        cs_prems 
          cs_simp: cat_FUNCT_cs_simps 
          cs_intro: cat_FUNCT_cs_intros cat_cs_intros
      )
  show "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 :
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF.iso cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦CΞ± 𝔅"
    by 
      (
        rule CZH_ECAT_NTCF.is_arr_isomorphism_is_iso_ntcf[
          OF 𝔑_is_arr(1) inv_𝔑_is_arr(1) 𝔑_inv_𝔑 inv_𝔑_𝔑 
          ]
      )
  show "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
    by (intro 𝔑_is_arr(2-4))+   
qed



subsectionβ€Ήβ€ΉFunctβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_Funct :: "V β‡’ V β‡’ V β‡’ V"
  where "cat_Funct Ξ± 𝔄 𝔅 =
    [
      tm_cf_maps Ξ± 𝔄 𝔅,
      tm_ntcf_arrows Ξ± 𝔄 𝔅,
      (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈),
      (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈),
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_Funct Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ),
      (Ξ»π”‰βˆˆβˆ˜tm_cf_maps Ξ± 𝔄 𝔅. ntcf_arrow_id 𝔄 𝔅 𝔉)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_Funct_components: 
  shows "cat_Funct Ξ± 𝔄 𝔅⦇Obj⦈ = tm_cf_maps Ξ± 𝔄 𝔅"
    and "cat_Funct Ξ± 𝔄 𝔅⦇Arr⦈ = tm_ntcf_arrows Ξ± 𝔄 𝔅"
    and "cat_Funct Ξ± 𝔄 𝔅⦇Dom⦈ = (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTDom⦈)"
    and "cat_Funct Ξ± 𝔄 𝔅⦇Cod⦈ = (Ξ»π”‘βˆˆβˆ˜tm_ntcf_arrows Ξ± 𝔄 𝔅. 𝔑⦇NTCod⦈)"
    and "cat_Funct Ξ± 𝔄 𝔅⦇Comp⦈ =
      (Ξ»π”π”‘βˆˆβˆ˜composable_arrs (dg_Funct Ξ± 𝔄 𝔅). 𝔐𝔑⦇0⦈ βˆ™NTCF𝔄,𝔅 𝔐𝔑⦇1β„•β¦ˆ)"
    and "cat_Funct Ξ± 𝔄 𝔅⦇CId⦈ = (Ξ»π”‰βˆˆβˆ˜tm_cf_maps Ξ± 𝔄 𝔅. ntcf_arrow_id 𝔄 𝔅 𝔉)"
  unfolding cat_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)


textβ€ΉSlicing.β€Ί

lemma cat_smc_Funct: "cat_smc (cat_Funct Ξ± 𝔄 𝔅) = smc_Funct Ξ± 𝔄 𝔅"
proof(rule vsv_eqI)
  show "vsv (cat_smc (cat_Funct Ξ± 𝔄 𝔅))" unfolding cat_smc_def by auto
  show "vsv (smc_Funct Ξ± 𝔄 𝔅)" unfolding smc_Funct_def by auto
  have dom_lhs: "π’Ÿβˆ˜ (cat_smc (cat_Funct Ξ± 𝔄 𝔅)) = 5β„•" 
    unfolding cat_smc_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ (smc_Funct Ξ± 𝔄 𝔅) = 5β„•"
    unfolding smc_Funct_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ (cat_smc (cat_Funct Ξ± 𝔄 𝔅)) = π’Ÿβˆ˜ (smc_Funct Ξ± 𝔄 𝔅)"
    unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ (cat_smc (cat_Funct Ξ± 𝔄 𝔅)) ⟹
    cat_smc (cat_Funct Ξ± 𝔄 𝔅)⦇a⦈ = smc_Funct Ξ± 𝔄 𝔅⦇a⦈"
    for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral,
        unfold cat_smc_def dg_field_simps cat_Funct_def smc_Funct_def
      )
      (auto simp: nat_omega_simps)
qed

context is_tm_ntcf
begin

lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]: 
  cat_Funct_Dom_app = smc_Funct_Dom_app
  and cat_Funct_Cod_app = smc_Funct_Cod_app

end

lemmas [cat_FUNCT_cs_simps] = 
  is_tm_ntcf.cat_Funct_Dom_app
  is_tm_ntcf.cat_Funct_Cod_app

lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]: 
  cat_Funct_Dom_vsv[cat_FUNCT_cs_intros] = smc_Funct_Dom_vsv
  and cat_Funct_Dom_vdomain[cat_FUNCT_cs_simps] = smc_Funct_Dom_vdomain
  and cat_Funct_Cod_vsv[cat_FUNCT_cs_intros] = smc_Funct_Cod_vsv
  and cat_Funct_Cod_vdomain[cat_FUNCT_cs_simps] = smc_Funct_Cod_vdomain
  and cat_Funct_Dom_vrange = smc_Funct_Dom_vrange
  and cat_Funct_Cod_vrange = smc_Funct_Cod_vrange
  and cat_Funct_is_arrI = smc_Funct_is_arrI
  and cat_Funct_is_arrI'[cat_FUNCT_cs_intros] = smc_Funct_is_arrI'
  and cat_Funct_is_arrD = smc_Funct_is_arrD
  and cat_Funct_is_arrE[elim] = smc_Funct_is_arrE

lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]: 
  cat_Funct_Comp_app[cat_FUNCT_cs_simps] = smc_Funct_Comp_app


subsubsectionβ€ΉIdentityβ€Ί

mk_VLambda cat_Funct_components(6)
  |vsv cat_Funct_CId_vsv[intro]|
  |vdomain cat_Funct_CId_vdomain[cat_FUNCT_cs_simps]|
  |app cat_Funct_CId_app[cat_FUNCT_cs_simps]|

lemma smc_Funct_CId_vrange: "β„›βˆ˜ (cat_Funct Ξ± 𝔄 𝔅⦇CId⦈) βŠ†βˆ˜ ntcf_arrows Ξ± 𝔄 𝔅"
  unfolding cat_Funct_components
proof(rule vrange_VLambda_vsubset)
  fix 𝔉' assume "𝔉' ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
  then obtain 𝔉 where 𝔉'_def: "𝔉' = cf_map 𝔉" and 𝔉: "𝔉 : 𝔄 ↦↦C.tmΞ± 𝔅"
    by clarsimp  
  then show "ntcf_arrow_id 𝔄 𝔅 𝔉' ∈∘ ntcf_arrows Ξ± 𝔄 𝔅"
    by 
      (
        cs_concl
          cs_simp: cat_FUNCT_cs_simps 𝔉'_def
          cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
      )
qed


subsubsectionβ€Ήβ€ΉFunctβ€Ί is a categoryβ€Ί

lemma category_cat_Funct: 
  assumes "tiny_category Ξ± 𝔄" and "category Ξ± 𝔅"
  shows "category Ξ± (cat_Funct Ξ± 𝔄 𝔅)" (is β€Ήcategory Ξ± ?Functβ€Ί)
proof-
  interpret tiny_category Ξ± 𝔄 by (rule assms(1))
  show ?thesis
  proof(intro categoryI)
    show "vfsequence ?Funct" by (simp add: cat_Funct_def)
    show "vcard ?Funct = 6β„•" 
      unfolding cat_Funct_def by (simp add: nat_omega_simps)
    from assms show "semicategory Ξ± (cat_smc (cat_Funct Ξ± 𝔄 𝔅))"
      unfolding cat_smc_Funct by (rule semicategory_smc_Funct)
    show "π’Ÿβˆ˜ (cat_Funct Ξ± 𝔄 𝔅⦇CId⦈) = cat_Funct Ξ± 𝔄 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_Funct_components cat_FUNCT_cs_simps)
    show "cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦ˆ : 𝔉 ↦cat_Funct Ξ± 𝔄 𝔅 𝔉"
      if "𝔉 ∈∘ cat_Funct Ξ± 𝔄 𝔅⦇Obj⦈" for 𝔉
    proof-
      from that have "𝔉 ∈∘ tm_cf_maps Ξ± 𝔄 𝔅"
        unfolding cat_Funct_components by simp
      then obtain 𝔉' 
        where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉': "𝔉' : 𝔄 ↦↦C.tmΞ± 𝔅" 
        by auto
      from assms 𝔉' show "cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦ˆ : 𝔉 ↦cat_Funct Ξ± 𝔄 𝔅 𝔉"
        by 
          (
            cs_concl 
              cs_simp: cat_FUNCT_cs_simps 𝔉_def
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
          )
    qed
    show "cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ ∘Acat_Funct Ξ± 𝔄 𝔅 𝔑 = 𝔑"
      if "𝔑 : 𝔉 ↦cat_Funct Ξ± 𝔄 𝔅 π”Š" for 𝔉 π”Š 𝔑
    proof-
      note 𝔑 = cat_Funct_is_arrD[OF that]
      from assms 𝔑(1) show
        "cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ ∘Acat_Funct Ξ± 𝔄 𝔅 𝔑 = 𝔑"
        by (subst (1 2) 𝔑(2), use nothing in β€Ήsubst 𝔑(4)β€Ί)
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
          )
    qed
    show "𝔑 ∘Acat_Funct Ξ± 𝔄 𝔅 cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ = 𝔑"
      if "𝔑 : π”Š ↦cat_Funct Ξ± 𝔄 𝔅 β„Œ" for π”Š β„Œ 𝔑
    proof-
      note 𝔑 = cat_Funct_is_arrD[OF that]
      from assms 𝔑(1) show 
        "𝔑 ∘Acat_Funct Ξ± 𝔄 𝔅 cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ = 𝔑"
        by (subst (1 2) 𝔑(2), use nothing in β€Ήsubst 𝔑(3)β€Ί)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
          )
    qed
  qed auto
qed

lemma category_cat_Funct'[cat_FUNCT_cs_intros]:
  assumes "tiny_category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "Ξ² = Ξ±"
  shows "category Ξ± (cat_Funct Ξ² 𝔄 𝔅)"
  using assms(1,2) unfolding assms(3) by (rule category_cat_Funct)


subsubsectionβ€Ήβ€ΉFunctβ€Ί is a subcategory of β€ΉFUNCTβ€Ίβ€Ί

lemma subcategory_cat_Funct_cat_FUNCT:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "tiny_category Ξ± 𝔄" and "category Ξ± 𝔅"
  shows "cat_Funct Ξ± 𝔄 𝔅 βŠ†CΞ² cat_FUNCT Ξ± 𝔄 𝔅"
proof
  (
    intro subcategoryI, 
    unfold cat_smc_FUNCT cat_smc_Funct cat_Funct_components(1)
  )
  interpret category Ξ± 𝔅 by (rule assms(4))
  interpret 𝔄𝔅: category Ξ± β€Ήcat_Funct Ξ± 𝔄 𝔅›
    by (rule category_cat_Funct[OF assms(3,4)])
  show "category Ξ² (cat_Funct Ξ± 𝔄 𝔅)"
    by (rule category.cat_category_if_ge_Limit[OF _ assms(1,2)]) 
      (auto intro: cat_cs_intros)
  from assms show "category Ξ² (cat_FUNCT Ξ± 𝔄 𝔅)"
    by (cs_concl cs_intro: tiny_category_cat_FUNCT cat_small_cs_intros)
  show "smc_Funct Ξ± 𝔄 𝔅 βŠ†SMCΞ² smc_FUNCT Ξ± 𝔄 𝔅"
    by (rule subsemicategory_smc_Funct_smc_FUNCT[OF assms])
  show "cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦ˆ = cat_FUNCT Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦ˆ" 
    if ‹𝔉 ∈∘ tm_cf_maps Ξ± 𝔄 𝔅› for 𝔉
  proof-
    from that obtain 𝔉' where 𝔉_def: "𝔉 = cf_map 𝔉'" 
      and 𝔉': "𝔉' : 𝔄 ↦↦C.tmΞ± 𝔅"
      by auto
    from that show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_FUNCT_cs_intros tm_cf_maps_in_cf_maps
        )
  qed
qed


subsubsectionβ€ΉIsomorphismβ€Ί

lemma (in is_tm_iso_ntcf) cat_Funct_is_arr_isomorphismI: 
  assumes "category Ξ± 𝔅"
  shows "ntcf_arrow 𝔑 : cf_map 𝔉 ↦isocat_Funct Ξ± 𝔄 𝔅 cf_map π”Š"
proof(intro is_arr_isomorphismI is_inverseI)
  from is_tm_iso_ntcf_axioms show 
    "ntcf_arrow 𝔑 : cf_map 𝔉 ↦cat_Funct Ξ± 𝔄 𝔅 cf_map π”Š"
    by (cs_concl cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
  interpret inv_𝔑: is_tm_iso_ntcf Ξ± 𝔄 𝔅 π”Š 𝔉 β€Ήinv_ntcf 𝔑› 
    by (rule iso_tm_ntcf_is_arr_isomorphism(1)[OF assms is_tm_iso_ntcf_axioms]) 
  from inv_𝔑.is_tm_iso_ntcf_axioms show 
    "ntcf_arrow (inv_ntcf 𝔑) : cf_map π”Š ↦cat_Funct Ξ± 𝔄 𝔅 cf_map 𝔉"
    by (cs_concl cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
  from is_tm_iso_ntcf_axioms show 
    "ntcf_arrow 𝔑 : cf_map 𝔉 ↦cat_Funct Ξ± 𝔄 𝔅 cf_map π”Š" 
    by (cs_concl cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
  from assms is_tm_iso_ntcf_axioms show 
    "ntcf_arrow (inv_ntcf 𝔑) ∘Acat_Funct Ξ± 𝔄 𝔅 ntcf_arrow 𝔑 =
      cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡cf_map π”‰β¦ˆ"
    "ntcf_arrow 𝔑 ∘Acat_Funct Ξ± 𝔄 𝔅 ntcf_arrow (inv_ntcf 𝔑) =
      cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡cf_map π”Šβ¦ˆ"
    by
      (
        cs_concl
          cs_simp: iso_tm_ntcf_is_arr_isomorphism(2,3) cat_FUNCT_cs_simps
          cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
      )+
qed

lemma (in is_tm_iso_ntcf) cat_Funct_is_arr_isomorphismI': 
  assumes "category Ξ± 𝔅" 
    and "𝔑' = ntcf_arrow 𝔑" 
    and "𝔉' = cf_map 𝔉"
    and "π”Š' = cf_map π”Š"
  shows "𝔑' : 𝔉' ↦isocat_Funct Ξ± 𝔄 𝔅 cf_map π”Š"
  using assms(1) unfolding assms(2-4) by (rule cat_Funct_is_arr_isomorphismI)

lemmas [cat_FUNCT_cs_intros] = 
  is_tm_iso_ntcf.cat_Funct_is_arr_isomorphismI'[rotated 2]

lemma (in 𝒡) cat_Funct_is_arr_isomorphismD:
  assumes "tiny_category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "𝔑 : 𝔉 ↦isocat_Funct Ξ± 𝔄 𝔅 π”Š" (is ‹𝔑 : 𝔉 ↦iso?Funct π”Šβ€Ί)
  shows "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 :
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF.tm.iso cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦C.tmΞ± 𝔅" 
    and "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
proof-
  interpret Funct: category Ξ± ?Funct
    by (rule category_cat_Funct[OF assms(1,2)])
  have inv_𝔑: "𝔑¯C?Funct : π”Š ↦iso?Funct 𝔉"
    and inv_𝔑_𝔑: "𝔑¯C?Funct ∘A?Funct 𝔑 = ?Funct⦇CIdβ¦ˆβ¦‡π”‰β¦ˆ"
    and 𝔑_inv_𝔑: "𝔑 ∘A?Funct 𝔑¯C?Funct = ?Funct⦇CIdβ¦ˆβ¦‡π”Šβ¦ˆ"
    by 
      (
        intro 
          Funct.cat_the_inverse_is_arr_isomorphism[OF assms(3)] 
          Funct.cat_the_inverse_Comp_CId[OF assms(3)]
      )+
  from assms is_arr_isomorphismD inv_𝔑 
  have 𝔑_is_arr: "𝔑 : 𝔉 ↦cat_Funct Ξ± 𝔄 𝔅 π”Š" 
    and inv_𝔑_is_arr: "𝔑¯C?Funct : π”Š ↦cat_Funct Ξ± 𝔄 𝔅 𝔉"
    by auto
  note 𝔑_is_arr = cat_Funct_is_arrD[OF 𝔑_is_arr]
  note inv_𝔑_is_arr = cat_Funct_is_arrD[OF inv_𝔑_is_arr]
  let ?𝔑 = β€Ήntcf_of_ntcf_arrow 𝔄 𝔅 𝔑›
    and ?inv_𝔑 = β€Ήntcf_of_ntcf_arrow 𝔄 𝔅 (𝔑¯Ccat_Funct Ξ± 𝔄 𝔅)β€Ί
  from inv_𝔑_𝔑 𝔑_is_arr(1) inv_𝔑_is_arr(1) have inv_𝔑_𝔑:
    "?inv_𝔑 βˆ™NTCF ?𝔑 = ntcf_id (cf_of_cf_map 𝔄 𝔅 𝔉)"
    by  
      (
        subst (asm) inv_𝔑_is_arr(2), 
        use nothing in β€Ήsubst (asm) (2) 𝔑_is_arr(2), subst (asm) 𝔑_is_arr(3)β€Ί
      )
      (
        cs_prems 
          cs_simp: cat_FUNCT_cs_simps 
          cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
      )
  from 𝔑_inv_𝔑 inv_𝔑_is_arr(1) 𝔑_is_arr(1) have 𝔑_inv_𝔑:
    "?𝔑 βˆ™NTCF ?inv_𝔑 = ntcf_id (cf_of_cf_map 𝔄 𝔅 π”Š)"
    by
      (
        subst (asm) inv_𝔑_is_arr(2), 
        use nothing in β€Ήsubst (asm) 𝔑_is_arr(2), subst (asm) 𝔑_is_arr(4)β€Ί
      )
      (
        cs_prems
          cs_simp: cat_FUNCT_cs_simps
          cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
      )
  show "ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑 : 
    cf_of_cf_map 𝔄 𝔅 𝔉 ↦CF.tm.iso cf_of_cf_map 𝔄 𝔅 π”Š : 𝔄 ↦↦C.tmΞ± 𝔅"
    by 
      (
        rule is_arr_isomorphism_is_tm_iso_ntcf[
          OF 𝔑_is_arr(1) inv_𝔑_is_arr(1) 𝔑_inv_𝔑 inv_𝔑_𝔑 
          ]
      )
  show "𝔑 = ntcf_arrow (ntcf_of_ntcf_arrow 𝔄 𝔅 𝔑)"
    and "𝔉 = cf_map (cf_of_cf_map 𝔄 𝔅 𝔉)"
    and "π”Š = cf_map (cf_of_cf_map 𝔄 𝔅 π”Š)"
    by (intro 𝔑_is_arr(2-4))+   
qed



subsectionβ€ΉDiagonal functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III-3 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_diagonal :: "V β‡’ V β‡’ V β‡’ V" (β€ΉΞ”Cβ€Ί) 
  where "Ξ”C Ξ± 𝔍 β„­ = 
    [
      (Ξ»aβˆˆβˆ˜β„­β¦‡Obj⦈. cf_map (cf_const 𝔍 β„­ a)),
      (Ξ»fβˆˆβˆ˜β„­β¦‡Arr⦈. ntcf_arrow (ntcf_const 𝔍 β„­ f)), 
      β„­,
      cat_Funct Ξ± 𝔍 β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_diagonal_components:
  shows "Ξ”C Ξ± 𝔍 ℭ⦇ObjMap⦈ = (Ξ»aβˆˆβˆ˜β„­β¦‡Obj⦈. cf_map (cf_const 𝔍 β„­ a))"
    and "Ξ”C Ξ± 𝔍 ℭ⦇ArrMap⦈ = (Ξ»fβˆˆβˆ˜β„­β¦‡Arr⦈. ntcf_arrow (ntcf_const 𝔍 β„­ f))"
    and "Ξ”C Ξ± 𝔍 ℭ⦇HomDom⦈ = β„­"
    and "Ξ”C Ξ± 𝔍 ℭ⦇HomCod⦈ = cat_Funct Ξ± 𝔍 β„­"
  unfolding cf_diagonal_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda cf_diagonal_components(1)
  |vsv cf_diagonal_ObjMap_vsv[cat_cs_intros]|
  |vdomain cf_diagonal_ObjMap_vdomain[cat_cs_simps]|
  |app cf_diagonal_ObjMap_app[cat_cs_simps]|

lemma cf_diagonal_ObjMap_vrange:
  assumes "tiny_category Ξ± 𝔍" and "category Ξ± β„­"
  shows "β„›βˆ˜ (Ξ”C Ξ± 𝔍 ℭ⦇ObjMap⦈) βŠ†βˆ˜ cat_Funct Ξ± 𝔍 ℭ⦇Obj⦈"
  unfolding cf_diagonal_components 
proof(rule vrange_VLambda_vsubset)
  fix x assume "x ∈∘ ℭ⦇Obj⦈" 
  with assms category_cat_Funct[OF assms] show 
    "cf_map (cf_const 𝔍 β„­ x) ∈∘ cat_Funct Ξ± 𝔍 ℭ⦇Obj⦈"
    unfolding cat_Funct_components(1)
    by (cs_concl cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
qed


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda cf_diagonal_components(2)
  |vsv cf_diagonal_ArrMap_vsv[cat_cs_intros]|
  |vdomain cf_diagonal_ArrMap_vdomain[cat_cs_simps]|
  |app cf_diagonal_ArrMap_app[cat_cs_simps]|


subsubsectionβ€ΉDiagonal functor is a functorβ€Ί

lemma cf_diagonal_is_functor[cat_cs_intros]:
  assumes "tiny_category Ξ± 𝔍" and "category Ξ± β„­"
  shows "Ξ”C Ξ± 𝔍 β„­ : β„­ ↦↦CΞ± cat_Funct Ξ± 𝔍 β„­" (is β€Ή?Ξ” : β„­ ↦↦CΞ± ?Functβ€Ί)
proof-

  interpret 𝔍: tiny_category Ξ± 𝔍 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence ?Ξ”"
      unfolding cf_diagonal_def by (simp add: nat_omega_simps)
    from assms(2) show "category Ξ± β„­" 
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "category Ξ± ?Funct" 
      by (cs_concl cs_intro: cat_cs_intros category_cat_Funct)
    show "vcard ?Ξ” = 4β„•"
      unfolding cf_diagonal_def by (simp add: nat_omega_simps)
    show "vsv (?Δ⦇ObjMap⦈)" unfolding cf_diagonal_components by simp
    from assms show "β„›βˆ˜ (?Δ⦇ObjMap⦈) βŠ†βˆ˜ ?Funct⦇Obj⦈"
      by (rule cf_diagonal_ObjMap_vrange)
    show "?Δ⦇ArrMapβ¦ˆβ¦‡f⦈ : ?Δ⦇ObjMapβ¦ˆβ¦‡a⦈ ↦?Funct ?Δ⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦ℭ b" for f a b
      using that
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
        )
    show "?Δ⦇ArrMapβ¦ˆβ¦‡g ∘Aβ„­ f⦈ = ?Δ⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A?Funct ?Δ⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦ℭ c" and "f : a ↦ℭ b" for g b c f a
      using that 𝔍.category_axioms β„­.category_axioms
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    fix c assume "c ∈∘ ℭ⦇Obj⦈"
    with 𝔍.category_axioms β„­.category_axioms show 
      "?Δ⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = ?Funct⦇CIdβ¦ˆβ¦‡?Δ⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
  qed (auto simp: cf_diagonal_components cat_smc_FUNCT)

qed

lemma cf_diagonal_is_functor'[cat_cs_intros]:
  assumes "tiny_category Ξ± 𝔍" 
    and "category Ξ± β„­"
    and "Ξ±' = Ξ±"
    and "𝔄 = β„­"
    and "𝔅 = cat_Funct Ξ± 𝔍 β„­"
  shows "Ξ”C Ξ± 𝔍 β„­ : 𝔄 ↦↦CΞ±' 𝔅"
  using assms(1-2) unfolding assms(3-5) by (rule cf_diagonal_is_functor)



subsectionβ€ΉFunctor raised to the power of a categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
Most of the definitions and the results presented in this 
and the remaining subsections
can be found in \cite{mac_lane_categories_2010} and 
\cite{riehl_category_2016} (e.g., see Chapter X-3 
in \cite{mac_lane_categories_2010}).
β€Ί

definition exp_cf_cat :: "V β‡’ V β‡’ V β‡’ V"
  where "exp_cf_cat Ξ± π”Ž 𝔄 =
    [
      (
        Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomDom⦈)⦇Obj⦈.
          cf_map (π”Ž ∘CF cf_of_cf_map 𝔄 (π”Žβ¦‡HomDom⦈) 𝔖)
      ),
      (
        Ξ»Οƒβˆˆβˆ˜cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomDom⦈)⦇Arr⦈.
          ntcf_arrow (π”Ž ∘CF-NTCF ntcf_of_ntcf_arrow 𝔄 (π”Žβ¦‡HomDom⦈) Οƒ)
      ),
      cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomDom⦈),
      cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomCod⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma exp_cf_cat_components:
  shows "exp_cf_cat Ξ± π”Ž 𝔄⦇ObjMap⦈ = 
    (
      Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomDom⦈)⦇Obj⦈.
        cf_map (π”Ž ∘CF cf_of_cf_map 𝔄 (π”Žβ¦‡HomDom⦈) 𝔖)
    )"
    and 
    "exp_cf_cat Ξ± π”Ž 𝔄⦇ArrMap⦈ =
      (
        Ξ»Οƒβˆˆβˆ˜cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomDom⦈)⦇Arr⦈.
          ntcf_arrow  (π”Ž ∘CF-NTCF (ntcf_of_ntcf_arrow 𝔄 (π”Žβ¦‡HomDom⦈) Οƒ))
      )"
    and "exp_cf_cat Ξ± π”Ž 𝔄⦇HomDom⦈ = cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomDom⦈)"
    and "exp_cf_cat Ξ± π”Ž 𝔄⦇HomCod⦈ = cat_FUNCT Ξ± 𝔄 (π”Žβ¦‡HomCod⦈)"
  unfolding exp_cf_cat_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda exp_cf_cat_components(1)
  |vsv exp_cf_cat_components_ObjMap_vsv[cat_FUNCT_cs_intros]|

context 
  fixes Ξ± π”Ž 𝔅 β„­
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

mk_VLambda exp_cf_cat_components(1)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]
  |vdomain exp_cf_cat_components_ObjMap_vdomain[cat_FUNCT_cs_simps]|
  |app exp_cf_cat_components_ObjMap_app[cat_FUNCT_cs_simps]|

end


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda exp_cf_cat_components(2)
  |vsv exp_cf_cat_components_ArrMap_vsv[cat_FUNCT_cs_intros]|

context 
  fixes Ξ± π”Ž 𝔅 β„­
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

mk_VLambda exp_cf_cat_components(2)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]
  |vdomain exp_cf_cat_components_ArrMap_vdomain[cat_FUNCT_cs_simps]|
  |app exp_cf_cat_components_ArrMap_app[cat_FUNCT_cs_simps]|

end


subsubsectionβ€ΉDomain and codomainβ€Ί

context 
  fixes Ξ± π”Ž 𝔅 β„­
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

lemmas exp_cf_cat_HomDom[cat_FUNCT_cs_simps] = 
    exp_cf_cat_components(3)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]
  and exp_cf_cat_HomCod[cat_FUNCT_cs_simps] = 
    exp_cf_cat_components(4)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]

end


subsubsectionβ€ΉFunctor raised to the power of a category is a functorβ€Ί

lemma exp_cf_cat_is_tiny_functor: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "category Ξ± 𝔄" and "π”Ž : 𝔅 ↦↦CΞ± β„­"
  shows "exp_cf_cat Ξ± π”Ž 𝔄 : cat_FUNCT Ξ± 𝔄 𝔅 ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔄 β„­"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(3))
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(4))
  from assms(2-4) interpret 𝔄𝔅: tiny_category Ξ² β€Ήcat_FUNCT Ξ± 𝔄 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2-4) interpret 𝔄ℭ: tiny_category Ξ² β€Ήcat_FUNCT Ξ± 𝔄 β„­β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  show ?thesis
  proof(intro is_tiny_functorI' is_functorI')
    show "vfsequence (exp_cf_cat Ξ± π”Ž 𝔄)" unfolding exp_cf_cat_def by simp
    show "vcard (exp_cf_cat Ξ± π”Ž 𝔄) = 4β„•"
      unfolding exp_cf_cat_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (exp_cf_cat Ξ± π”Ž 𝔄⦇ObjMap⦈) βŠ†βˆ˜ cat_FUNCT Ξ± 𝔄 ℭ⦇Obj⦈"
    proof
      (
        unfold cat_FUNCT_components exp_cf_cat_components, 
        intro vrange_VLambda_vsubset, 
        unfold cat_cs_simps
      )
      fix 𝔉 assume "𝔉 ∈∘ cf_maps Ξ± 𝔄 𝔅"
      then obtain 𝔉' where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉': "𝔉' : 𝔄 ↦↦CΞ± 𝔅" 
        by auto
      from assms(2-4) 𝔉' show 
        "cf_map (π”Ž ∘CF cf_of_cf_map 𝔄 𝔅 𝔉) ∈∘ cf_maps Ξ± 𝔄 β„­"
        by (cs_concl cs_simp: 𝔉_def cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
    qed
    show "exp_cf_cat Ξ± π”Ž 𝔄⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ :
      exp_cf_cat Ξ± π”Ž 𝔄⦇ObjMapβ¦ˆβ¦‡π”‰β¦ˆ ↦cat_FUNCT Ξ± 𝔄 β„­
      exp_cf_cat Ξ± π”Ž 𝔄⦇ObjMapβ¦ˆβ¦‡π”Šβ¦ˆ"
      if "𝔑 : 𝔉 ↦cat_FUNCT Ξ± 𝔄 𝔅 π”Š" for 𝔉 π”Š 𝔑
    proof-
      note 𝔑 = cat_FUNCT_is_arrD[OF that]
      from 𝔑(1,3,4) assms(2-4) show ?thesis
      by (subst 𝔑(2), use nothing in β€Ήsubst 𝔑(3), subst 𝔑(4)β€Ί) 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    qed
    show 
      "exp_cf_cat Ξ± π”Ž 𝔄⦇ArrMapβ¦ˆβ¦‡π” ∘Acat_FUNCT Ξ± 𝔄 𝔅 π”‘β¦ˆ =
        exp_cf_cat Ξ± π”Ž 𝔄⦇ArrMapβ¦ˆβ¦‡π”β¦ˆ ∘Acat_FUNCT Ξ± 𝔄 β„­
        exp_cf_cat Ξ± π”Ž 𝔄⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ"
      if "𝔐 : π”Š ↦cat_FUNCT Ξ± 𝔄 𝔅 β„Œ" and "𝔑 : 𝔉 ↦cat_FUNCT Ξ± 𝔄 𝔅 π”Š"
      for π”Š β„Œ 𝔐 𝔉 𝔑
    proof-
      note 𝔐 = cat_FUNCT_is_arrD[OF that(1)]
        and 𝔑 = cat_FUNCT_is_arrD[OF that(2)]  
      from 𝔐(1,3,4) 𝔑(1,3,4) assms(2-4) show ?thesis  
        by (subst (1 2) 𝔐(2), use nothing in β€Ήsubst (1 2) 𝔑(2)β€Ί)
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps cf_ntcf_comp_ntcf_vcomp 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
    show 
      "exp_cf_cat Ξ± π”Ž 𝔄⦇ArrMapβ¦ˆβ¦‡cat_FUNCT Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦ˆβ¦ˆ =
        cat_FUNCT Ξ± 𝔄 ℭ⦇CIdβ¦ˆβ¦‡exp_cf_cat Ξ± π”Ž 𝔄⦇ObjMapβ¦ˆβ¦‡π”‰β¦ˆβ¦ˆ"
      if "𝔉 ∈∘ cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈" for 𝔉
    proof-
      from that[unfolded cat_FUNCT_components] obtain π”Š 
        where 𝔉_def: "𝔉 = cf_map π”Š" and π”Š: "π”Š : 𝔄 ↦↦CΞ± 𝔅"
        by auto
      from π”Š show
        "exp_cf_cat Ξ± π”Ž 𝔄⦇ArrMapβ¦ˆβ¦‡cat_FUNCT Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦ˆβ¦ˆ =
          cat_FUNCT Ξ± 𝔄 ℭ⦇CIdβ¦ˆβ¦‡exp_cf_cat Ξ± π”Ž 𝔄⦇ObjMapβ¦ˆβ¦‡π”‰β¦ˆβ¦ˆ" 
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 𝔉_def
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
  qed 
    (
      use assms(1,2) in
        β€Ή
          cs_concl
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        β€Ί
    )+
qed

lemma exp_cf_cat_is_tiny_functor'[cat_FUNCT_cs_intros]:
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β" 
    and "category Ξ± 𝔄" 
    and "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔄' = cat_FUNCT Ξ± 𝔄 𝔅"
    and "𝔅' = cat_FUNCT Ξ± 𝔄 β„­"
  shows "exp_cf_cat Ξ± π”Ž 𝔄 : 𝔄' ↦↦C.tinyΞ² 𝔅'"
  using assms(1-4) unfolding assms(5,6) by (rule exp_cf_cat_is_tiny_functor)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma exp_cf_cat_cf_comp:
  assumes "category Ξ± 𝔇" and "π”Š : 𝔅 ↦↦CΞ± β„­" and "𝔉 : 𝔄 ↦↦CΞ± 𝔅"
  shows "exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇 = exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇"
proof(rule cf_eqI)

  interpret 𝔇: category Ξ± 𝔇 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))
  interpret 𝔉: is_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(3))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔇.𝒡_Limit_Ξ±Ο‰ 𝔇.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔇.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  from Ξ±Ξ² show 
    "exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇 : cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔇 β„­"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  from Ξ±Ξ² show 
    "exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇 : 
      cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔇 β„­"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  from Ξ±Ξ² have dom_lhs:
    "π’Ÿβˆ˜ (exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ObjMap⦈) = cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  from Ξ±Ξ² have dom_rhs: 
    "π’Ÿβˆ˜ ((exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ObjMap⦈) = 
      cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
    by
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  show 
    "exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ObjMap⦈ =
      (exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ObjMap⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    show "vsv (exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ObjMap⦈)"
      by (cs_concl cs_intro: cat_FUNCT_cs_intros)
    from Ξ±Ξ² show "vsv ((exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ObjMap⦈)"
      by 
        (
          cs_concl cs_intro: 
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    fix β„Œ assume "β„Œ ∈∘ cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
    then have "β„Œ ∈∘ cf_maps Ξ± 𝔇 𝔄" unfolding cat_FUNCT_components by simp
    then obtain β„Œ' where β„Œ_def: "β„Œ = cf_map β„Œ'" and β„Œ': "β„Œ' : 𝔇 ↦↦CΞ± 𝔄" 
      by auto
    from assms Ξ±Ξ² β„Œ' show 
      "exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ =
        (exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ"
      by (subst (1 2) β„Œ_def)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
  qed simp
  from Ξ±Ξ² have dom_lhs:
    "π’Ÿβˆ˜ (exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ArrMap⦈) = cat_FUNCT Ξ± 𝔇 𝔄⦇Arr⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  from Ξ±Ξ² have dom_rhs: 
    "π’Ÿβˆ˜ ((exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ArrMap⦈) =
      cat_FUNCT Ξ± 𝔇 𝔄⦇Arr⦈"
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  show 
    "exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ArrMap⦈ =
      (exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    show "vsv (exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ArrMap⦈)"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
    from Ξ±Ξ² show "vsv ((exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ArrMap⦈)"
      by 
        (
          cs_concl cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )                           
    fix 𝔑 assume "𝔑 ∈∘ cat_FUNCT Ξ± 𝔇 𝔄⦇Arr⦈"
    then obtain β„Œ β„Œ' where 𝔑: "𝔑 : β„Œ ↦cat_FUNCT Ξ± 𝔇 𝔄 β„Œ'" 
      by (auto intro: is_arrI)
    note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
    from Ξ±Ξ² assms 𝔑(1,3,4) show 
      "exp_cf_cat Ξ± (π”Š ∘CF 𝔉) 𝔇⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ =
        (exp_cf_cat Ξ± π”Š 𝔇 ∘CF exp_cf_cat Ξ± 𝔉 𝔇)⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ"
      by (subst (1 2) 𝔑(2))
        (
          cs_concl
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps cf_comp_cf_ntcf_comp_assoc
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
  qed simp
qed simp_all

lemma exp_cf_cat_cf_id_cat:
  assumes "category Ξ± β„­" and "category Ξ± 𝔇"
  shows "exp_cf_cat Ξ± (cf_id β„­) 𝔇 = cf_id (cat_FUNCT Ξ± 𝔇 β„­)"
proof(rule cf_eqI)

  interpret β„­: category Ξ± β„­ by (rule assms)
  interpret 𝔇: category Ξ± 𝔇 by (rule assms)

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def β„­.𝒡_Limit_Ξ±Ο‰ β„­.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def β„­.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  from Ξ±Ξ² show
    "cf_id (cat_FUNCT Ξ± 𝔇 β„­) : cat_FUNCT Ξ± 𝔇 β„­ ↦↦CΞ² cat_FUNCT Ξ± 𝔇 β„­"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
  from Ξ±Ξ² show
    "exp_cf_cat Ξ± (cf_id β„­) 𝔇 : cat_FUNCT Ξ± 𝔇 β„­ ↦↦CΞ² cat_FUNCT Ξ± 𝔇 β„­"
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
  from Ξ±Ξ² have ObjMap_dom_lhs:
    "π’Ÿβˆ˜ (exp_cf_cat Ξ± (cf_id β„­) 𝔇⦇ObjMap⦈) = cat_FUNCT Ξ± 𝔇 ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
  from Ξ±Ξ² have ObjMap_dom_rhs:
    "π’Ÿβˆ˜ (cf_id (cat_FUNCT Ξ± 𝔇 β„­)⦇ObjMap⦈) = cat_FUNCT Ξ± 𝔇 ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  show "exp_cf_cat Ξ± (cf_id β„­) 𝔇⦇ObjMap⦈ = cf_id (cat_FUNCT Ξ± 𝔇 β„­)⦇ObjMap⦈"
  proof
    (
      rule vsv_eqI, 
      unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
    )
    fix β„Œ assume prems: "β„Œ ∈∘ cf_maps Ξ± 𝔇 β„­"
    then obtain β„Œ' where β„Œ_def: "β„Œ = cf_map β„Œ'" and β„Œ': "β„Œ' : 𝔇 ↦↦CΞ± β„­"
      by clarsimp
    from prems β„Œ' show 
      "exp_cf_cat Ξ± (cf_id β„­) 𝔇⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ = cf_id (cat_FUNCT Ξ± 𝔇 β„­)⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ"
      by (subst (1 2) β„Œ_def)
        (
          cs_concl
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
  from Ξ±Ξ² have ArrMap_dom_lhs:
    "π’Ÿβˆ˜ (cf_id (cat_FUNCT Ξ± 𝔇 β„­)⦇ArrMap⦈) = cat_FUNCT Ξ± 𝔇 ℭ⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from Ξ±Ξ² have ArrMap_dom_rhs:
    "π’Ÿβˆ˜ (exp_cf_cat Ξ± (cf_id β„­) 𝔇⦇ArrMap⦈) = cat_FUNCT Ξ± 𝔇 ℭ⦇Arr⦈"
    by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
  show "exp_cf_cat Ξ± (cf_id β„­) 𝔇⦇ArrMap⦈ = cf_id (cat_FUNCT Ξ± 𝔇 β„­)⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix 𝔑 assume "𝔑 ∈∘ cat_FUNCT Ξ± 𝔇 ℭ⦇Arr⦈"
    then obtain 𝔉 π”Š where 𝔑: "𝔑 : 𝔉 ↦cat_FUNCT Ξ± 𝔇 β„­ π”Š" 
      by (auto intro: is_arrI)
    note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
    from 𝔑(1,3,4) Ξ±Ξ² show 
      "exp_cf_cat Ξ± (cf_id β„­) 𝔇⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ =
        cf_id (cat_FUNCT Ξ± 𝔇 β„­)⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ"
      by (subst (1 2) 𝔑(2))
        (
          cs_concl
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

qed simp_all


lemma cf_comp_exp_cf_cat_exp_cf_cat_cf_id[cat_FUNCT_cs_simps]:
  assumes "category Ξ± 𝔄" and "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄 = exp_cf_cat Ξ± 𝔉 𝔄"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(2))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²"
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule cf_eqI)
    from assms Ξ±Ξ² Ξ² show 𝔉𝔄:
      "exp_cf_cat Ξ± 𝔉 𝔄 : cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by (cs_concl cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
    with assms Ξ±Ξ² show 
      "exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄 :
        cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl cs_intro: 
            cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from assms Ξ±Ξ² have ObjMap_dom_lhs:
      "π’Ÿβˆ˜ ((exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄)⦇ObjMap⦈) =
        cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from assms have ObjMap_dom_rhs: 
      "π’Ÿβˆ˜ (exp_cf_cat Ξ± 𝔉 𝔄⦇ObjMap⦈) = cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_FUNCT_cs_simps)
    from assms Ξ±Ξ² have ArrMap_dom_lhs:
      "π’Ÿβˆ˜ ((exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄)⦇ArrMap⦈) =
        cat_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from assms have ArrMap_dom_rhs: 
      "π’Ÿβˆ˜ (exp_cf_cat Ξ± 𝔉 𝔄⦇ArrMap⦈) = cat_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈"
      by (cs_concl cs_simp: cat_FUNCT_cs_simps)
    show 
      "(exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄)⦇ObjMap⦈ =
        exp_cf_cat Ξ± 𝔉 𝔄⦇ObjMap⦈"
    proof
      (
        rule vsv_eqI,
        unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
      )
      fix β„Œ assume prems: "β„Œ ∈∘ cf_maps Ξ± 𝔄 𝔅"
      then obtain β„Œ' where β„Œ_def: "β„Œ = cf_map β„Œ'" and β„Œ': "β„Œ' : 𝔄 ↦↦CΞ± 𝔅" 
        by clarsimp
      from prems β„Œ' assms 𝔉𝔄 Ξ±Ξ² show 
        "(exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄)⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ =
          exp_cf_cat Ξ± 𝔉 𝔄⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ"
        unfolding β„Œ_def
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          )
    qed 
      (
        use assms 𝔉𝔄 Ξ±Ξ² in
          β€Ή
            cs_concl
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          β€Ί
      )
    show 
      "(exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄)⦇ArrMap⦈ =
        exp_cf_cat Ξ± 𝔉 𝔄⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix 𝔐 assume "𝔐 ∈∘ cat_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈"
      then obtain 𝔉' π”Š' where 𝔐: "𝔐 : 𝔉' ↦cat_FUNCT Ξ± 𝔄 𝔅 π”Š'"
        by (auto intro: is_arrI)
      note 𝔐 = cat_FUNCT_is_arrD[OF 𝔐]
      from 𝔐(1) assms 𝔉𝔄 Ξ±Ξ² show 
        "(exp_cf_cat Ξ± 𝔉 𝔄 ∘CF exp_cf_cat Ξ± (cf_id 𝔅) 𝔄)⦇ArrMapβ¦ˆβ¦‡π”β¦ˆ =
          exp_cf_cat Ξ± 𝔉 𝔄⦇ArrMapβ¦ˆβ¦‡π”β¦ˆ"
        by (subst (1 2) 𝔐(2))
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          )
    qed
      (
        use assms Ξ±Ξ² in 
          β€Ή
            cs_concl cs_intro:
              cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          β€Ί
      )
  qed simp_all

qed

lemma cf_comp_exp_cf_cat_cf_id_exp_cf_cat[cat_FUNCT_cs_simps]:
  assumes "category Ξ± 𝔄" and "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄 = exp_cf_cat Ξ± 𝔉 𝔄"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(2))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule cf_eqI)
    from assms Ξ±Ξ² Ξ² show 𝔉𝔄:
      "exp_cf_cat Ξ± 𝔉 𝔄 : cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by (cs_concl cs_simp: cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
    with assms Ξ±Ξ² show 
      "exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄 :
        cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl cs_intro: 
            cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from assms Ξ±Ξ² have ObjMap_dom_lhs:
      "π’Ÿβˆ˜ ((exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄)⦇ObjMap⦈) =
        cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from assms have ObjMap_dom_rhs: 
      "π’Ÿβˆ˜ (exp_cf_cat Ξ± 𝔉 𝔄⦇ObjMap⦈) = cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_FUNCT_cs_simps)
    from assms Ξ±Ξ² have ArrMap_dom_lhs:
      "π’Ÿβˆ˜ ((exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄)⦇ArrMap⦈) =
        cat_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈"
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from assms have ArrMap_dom_rhs: 
      "π’Ÿβˆ˜ (exp_cf_cat Ξ± 𝔉 𝔄⦇ArrMap⦈) = cat_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈"
      by (cs_concl cs_simp: cat_FUNCT_cs_simps)
    show 
      "(exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄)⦇ObjMap⦈ =
        exp_cf_cat Ξ± 𝔉 𝔄⦇ObjMap⦈"
    proof
      (
        rule vsv_eqI, 
        unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
      )
      fix β„Œ assume prems: "β„Œ ∈∘ cf_maps Ξ± 𝔄 𝔅"
      then obtain β„Œ' where β„Œ_def: "β„Œ = cf_map β„Œ'" and β„Œ': "β„Œ' : 𝔄 ↦↦CΞ± 𝔅" 
        by clarsimp
      from prems β„Œ' assms Ξ±Ξ² 𝔉𝔄 show 
        "(exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄)⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ =
          exp_cf_cat Ξ± 𝔉 𝔄⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ"
        unfolding β„Œ_def
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          )
    qed 
      (
        use assms Ξ±Ξ² 𝔉𝔄 in 
          β€Ή
            cs_concl
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          β€Ί
      )
    show 
      "(exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄)⦇ArrMap⦈ =
        exp_cf_cat Ξ± 𝔉 𝔄⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix 𝔐 assume "𝔐 ∈∘ cat_FUNCT Ξ± 𝔄 𝔅⦇Arr⦈"
      then obtain 𝔉' π”Š' where 𝔐: "𝔐 : 𝔉' ↦cat_FUNCT Ξ± 𝔄 𝔅 π”Š'"
        by (auto intro: is_arrI)
      note 𝔐 = cat_FUNCT_is_arrD[OF 𝔐]
      from 𝔐(1) assms Ξ±Ξ² 𝔉𝔄 show 
        "(exp_cf_cat Ξ± (cf_id β„­) 𝔄 ∘CF exp_cf_cat Ξ± 𝔉 𝔄)⦇ArrMapβ¦ˆβ¦‡π”β¦ˆ =
          exp_cf_cat Ξ± 𝔉 𝔄⦇ArrMapβ¦ˆβ¦‡π”β¦ˆ"
        by (subst (1 2) 𝔐(2))
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          )
    qed
      (
        use assms Ξ±Ξ² in
          β€Ή
            cs_concl
              cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
          β€Ί
      )
  qed simp_all

qed



subsectionβ€ΉCategory raised to the power of a functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition exp_cat_cf :: "V β‡’ V β‡’ V β‡’ V"
  where "exp_cat_cf Ξ± 𝔄 π”Ž =
    [
      (
        Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± (π”Žβ¦‡HomCod⦈) 𝔄⦇Obj⦈.
          cf_map (cf_of_cf_map (π”Žβ¦‡HomCod⦈) 𝔄 𝔖 ∘CF π”Ž)
      ),
      (
        Ξ»Οƒβˆˆβˆ˜cat_FUNCT Ξ± (π”Žβ¦‡HomCod⦈) 𝔄⦇Arr⦈.
          ntcf_arrow (ntcf_of_ntcf_arrow (π”Žβ¦‡HomCod⦈) 𝔄 Οƒ ∘NTCF-CF π”Ž)
      ),
      cat_FUNCT Ξ± (π”Žβ¦‡HomCod⦈) 𝔄,
      cat_FUNCT Ξ± (π”Žβ¦‡HomDom⦈) 𝔄 
    ]∘"


textβ€ΉComponents.β€Ί

lemma exp_cat_cf_components:
  shows "exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ObjMap⦈ =
    (
      Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± (π”Žβ¦‡HomCod⦈) 𝔄⦇Obj⦈.
        cf_map (cf_of_cf_map (π”Žβ¦‡HomCod⦈) 𝔄 𝔖 ∘CF π”Ž)
    )"
    and "exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ArrMap⦈ = 
    (
      Ξ»Οƒβˆˆβˆ˜cat_FUNCT Ξ± (π”Žβ¦‡HomCod⦈) 𝔄⦇Arr⦈.
        ntcf_arrow (ntcf_of_ntcf_arrow (π”Žβ¦‡HomCod⦈) 𝔄 Οƒ ∘NTCF-CF π”Ž)
    )"
    and "exp_cat_cf Ξ± 𝔄 π”Žβ¦‡HomDom⦈ = cat_FUNCT Ξ± (π”Žβ¦‡HomCod⦈) 𝔄"
    and "exp_cat_cf Ξ± 𝔄 π”Žβ¦‡HomCod⦈ = cat_FUNCT Ξ± (π”Žβ¦‡HomDom⦈) 𝔄"
  unfolding exp_cat_cf_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

context 
  fixes Ξ± π”Ž 𝔅 β„­
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

mk_VLambda exp_cat_cf_components(1)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]
  |vsv exp_cat_cf_components_ObjMap_vsv[cat_FUNCT_cs_intros]|
  |vdomain exp_cat_cf_components_ObjMap_vdomain[cat_FUNCT_cs_simps]|
  |app exp_cat_cf_components_ObjMap_app[cat_FUNCT_cs_simps]|

end


subsubsectionβ€ΉArrow mapβ€Ί

context 
  fixes Ξ± π”Ž 𝔅 β„­
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

mk_VLambda exp_cat_cf_components(2)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]
  |vsv exp_cat_cf_components_ArrMap_vsv[cat_FUNCT_cs_intros]|
  |vdomain exp_cat_cf_components_ArrMap_vdomain[cat_FUNCT_cs_simps]|
  |app exp_cat_cf_components_ArrMap_app[cat_FUNCT_cs_simps]|

end


subsubsectionβ€ΉDomain and codomainβ€Ί

context 
  fixes Ξ± π”Ž 𝔅 β„­
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

lemmas exp_cat_cf_HomDom[cat_FUNCT_cs_simps] = 
    exp_cat_cf_components(3)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]
  and exp_cat_cf_HomCod[cat_FUNCT_cs_simps] = 
    exp_cat_cf_components(4)[where π”Ž=π”Ž and Ξ±=Ξ±, unfolded cat_cs_simps]

end


subsubsectionβ€ΉCategory raised to the power of a functor is a functorβ€Ί

lemma exp_cat_cf_is_tiny_functor: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "category Ξ± 𝔄" and "π”Ž : 𝔅 ↦↦CΞ± β„­"
  shows "exp_cat_cf Ξ± 𝔄 π”Ž : cat_FUNCT Ξ± β„­ 𝔄 ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔅 𝔄"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(3))
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(4))
  from assms(2-4) interpret ℭ𝔄: tiny_category Ξ² β€Ήcat_FUNCT Ξ± β„­ 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2-4) interpret 𝔅𝔄: tiny_category Ξ² β€Ήcat_FUNCT Ξ± 𝔅 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  show ?thesis
  proof(intro is_tiny_functorI' is_functorI')
    show "vfsequence (exp_cat_cf Ξ± 𝔄 π”Ž)" unfolding exp_cat_cf_def by auto
    show "vcard (exp_cat_cf Ξ± 𝔄 π”Ž) = 4β„•"
      unfolding exp_cat_cf_def by (simp_all add: nat_omega_simps)
    show "β„›βˆ˜ (exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ObjMap⦈) βŠ†βˆ˜ cat_FUNCT Ξ± 𝔅 𝔄⦇Obj⦈"
    proof
      (
        unfold cat_FUNCT_components exp_cat_cf_components, 
        intro vrange_VLambda_vsubset, 
        unfold cat_cs_simps
      )
      fix 𝔉 assume "𝔉 ∈∘ cf_maps Ξ± β„­ 𝔄"
      then obtain 𝔉' where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉': "𝔉' : β„­ ↦↦CΞ± 𝔄" 
        by auto
      from assms(2-4) 𝔉' show 
        "cf_map (cf_of_cf_map β„­ 𝔄 𝔉 ∘CF π”Ž) ∈∘ cf_maps Ξ± 𝔅 𝔄"
        unfolding 𝔉_def
        by 
          ( 
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
    show "exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ArrMapβ¦ˆβ¦‡π”‘β¦ˆ :
      exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦ˆ ↦cat_FUNCT Ξ± 𝔅 𝔄
      exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”Šβ¦ˆ"
      if "𝔑 : 𝔉 ↦cat_FUNCT Ξ± β„­ 𝔄 π”Š" for 𝔉 π”Š 𝔑 
    proof-
      note 𝔑 = cat_FUNCT_is_arrD[OF that]
      from 𝔑(1) assms(2-4) show ?thesis
        by (subst 𝔑(2), use nothing in β€Ήsubst 𝔑(3), subst 𝔑(4)β€Ί) 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros  cat_FUNCT_cs_intros
          )
    qed
    show
      "exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ArrMapβ¦ˆβ¦‡π” ∘Acat_FUNCT Ξ± β„­ 𝔄 π”‘β¦ˆ =
        exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ArrMapβ¦ˆβ¦‡π”β¦ˆ ∘Acat_FUNCT Ξ± 𝔅 𝔄
        exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ArrMapβ¦ˆβ¦‡π”‘β¦ˆ"
      if "𝔐 : π”Š ↦cat_FUNCT Ξ± β„­ 𝔄 β„Œ" and "𝔑 : 𝔉 ↦cat_FUNCT Ξ± β„­ 𝔄 π”Š" 
      for π”Š β„Œ 𝔐 𝔉 𝔑
    proof-
      note 𝔐 = cat_FUNCT_is_arrD[OF that(1)]
        and 𝔑 = cat_FUNCT_is_arrD[OF that(2)]  
      from 𝔐(1) 𝔑(1) assms(2-4) show ?thesis  
        by (subst (1 2) 𝔐(2), use nothing in β€Ήsubst (1 2) 𝔑(2)β€Ί)
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps  
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
    show
      "exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ArrMapβ¦ˆβ¦‡cat_FUNCT Ξ± β„­ 𝔄⦇CIdβ¦ˆβ¦‡π”‰β¦ˆβ¦ˆ =
        cat_FUNCT Ξ± 𝔅 𝔄⦇CIdβ¦ˆβ¦‡exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦ˆβ¦ˆ"
      if "𝔉 ∈∘ cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈" for 𝔉
    proof-
      from that have 𝔉: "𝔉 ∈∘ cf_maps Ξ± β„­ 𝔄" 
        unfolding cat_FUNCT_components by simp
      then obtain 𝔉' where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉': "𝔉' : β„­ ↦↦CΞ± 𝔄" 
        by auto
      from assms(2-4) 𝔉 𝔉' show ?thesis
        by 
          (
            cs_concl
              cs_simp: 
                cat_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1) 𝔉_def
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
  qed 
    (
      cs_concl 
        cs_simp: cat_FUNCT_cs_simps
        cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
    )+
qed

lemma exp_cat_cf_is_tiny_functor'[cat_FUNCT_cs_intros]: 
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β" 
    and "category Ξ± 𝔄" 
    and "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔄' = cat_FUNCT Ξ± β„­ 𝔄"
    and "𝔅' = cat_FUNCT Ξ± 𝔅 𝔄"
  shows "exp_cat_cf Ξ± 𝔄 π”Ž : 𝔄' ↦↦C.tinyΞ² 𝔅'"
  using assms(1-4) unfolding assms(5,6) by (rule exp_cat_cf_is_tiny_functor)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma exp_cat_cf_cat_cf_id:
  assumes "category Ξ± 𝔄" and "category Ξ± β„­"
  shows "exp_cat_cf Ξ± 𝔄 (cf_id β„­) = cf_id (cat_FUNCT Ξ± β„­ 𝔄)"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret β„­: category Ξ± β„­ by (rule assms(2))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule cf_eqI)

    from Ξ±Ξ² show "exp_cat_cf Ξ± 𝔄 (cf_id β„­) :
      cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± β„­ 𝔄"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² show 
      "cf_id (cat_FUNCT Ξ± β„­ 𝔄) : cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± β„­ 𝔄"
      by
        (
          cs_concl
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have ObjMap_dom_lhs:
      "π’Ÿβˆ˜ (exp_cat_cf Ξ± 𝔄 (cf_id β„­)⦇ObjMap⦈) = cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have ObjMap_dom_rhs:
      "π’Ÿβˆ˜ (cf_id (cat_FUNCT Ξ± β„­ 𝔄)⦇ObjMap⦈) = cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
        )
    show "exp_cat_cf Ξ± 𝔄 (cf_id β„­)⦇ObjMap⦈ = cf_id (cat_FUNCT Ξ± β„­ 𝔄)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1))
      fix 𝔉 assume "𝔉 ∈∘ cf_maps Ξ± β„­ 𝔄"
      then obtain 𝔉' where 𝔉_def: "𝔉 = cf_map 𝔉'" and 𝔉': "𝔉' : β„­ ↦↦CΞ± 𝔄" 
        by clarsimp
      from 𝔉' show 
        "exp_cat_cf Ξ± 𝔄 (cf_id β„­)⦇ObjMapβ¦ˆβ¦‡π”‰β¦ˆ =
          cf_id (cat_FUNCT Ξ± β„­ 𝔄)⦇ObjMapβ¦ˆβ¦‡π”‰β¦ˆ"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 𝔉_def 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+

    from Ξ±Ξ² have ArrMap_dom_lhs: 
      "π’Ÿβˆ˜ (exp_cat_cf Ξ± 𝔄 (cf_id β„­)⦇ArrMap⦈) = cat_FUNCT Ξ± β„­ 𝔄⦇Arr⦈"
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have ArrMap_dom_rhs:
      "π’Ÿβˆ˜ (cf_id (cat_FUNCT Ξ± β„­ 𝔄)⦇ArrMap⦈) = cat_FUNCT Ξ± β„­ 𝔄⦇Arr⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
        )
    show "exp_cat_cf Ξ± 𝔄 (cf_id β„­)⦇ArrMap⦈ = cf_id (cat_FUNCT Ξ± β„­ 𝔄)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix 𝔑 assume "𝔑 ∈∘ cat_FUNCT Ξ± β„­ 𝔄⦇Arr⦈"
      then obtain β„Œ β„Œ' where 𝔑: "𝔑 : β„Œ ↦cat_FUNCT Ξ± β„­ 𝔄 β„Œ'" 
        by (auto intro: is_arrI)
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
      from 𝔑(1) show 
        "exp_cat_cf Ξ± 𝔄 (cf_id β„­)⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ =
          cf_id (cat_FUNCT Ξ± β„­ 𝔄)⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ"
        by (subst (1 2) 𝔑(2))
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+

  qed simp_all

qed

lemma exp_cat_cf_cf_comp:
  assumes "category Ξ± 𝔄" and "π”Š : β„­ ↦↦CΞ± 𝔇" and "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉) = exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­ 𝔇 π”Š by (rule assms(2))
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(3))
 
  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule cf_eqI)  
    from Ξ² Ξ±Ξ² show "exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉) :
      cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔅 𝔄"
      by
        (
          cs_concl 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ² Ξ±Ξ² show "exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š :
      cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔅 𝔄"
      by 
        (
          cs_concl
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ² Ξ±Ξ² have ObjMap_dom_lhs: 
      "π’Ÿβˆ˜ (exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉)⦇ObjMap⦈) = cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ² Ξ±Ξ² have ObjMap_dom_rhs: 
      "π’Ÿβˆ˜ ((exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š)⦇ObjMap⦈) =
        cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ² Ξ±Ξ² have ArrMap_dom_lhs: 
      "π’Ÿβˆ˜ (exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉)⦇ArrMap⦈) = cat_FUNCT Ξ± 𝔇 𝔄⦇Arr⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ² Ξ±Ξ² have ArrMap_dom_rhs: 
      "π’Ÿβˆ˜ ((exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š)⦇ArrMap⦈) =
        cat_FUNCT Ξ± 𝔇 𝔄⦇Arr⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    show 
      "exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉)⦇ObjMap⦈ =
        (exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š)⦇ObjMap⦈"
    proof
      (
        rule vsv_eqI, 
        unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
      )
      fix β„Œ assume "β„Œ ∈∘ cf_maps Ξ± 𝔇 𝔄"
      then obtain β„Œ' where β„Œ_def: "β„Œ = cf_map β„Œ'" and β„Œ': "β„Œ' : 𝔇 ↦↦CΞ± 𝔄"
        by clarsimp
      from Ξ² Ξ±Ξ²  β„Œ' assms show 
        "exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ =
          (exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š)⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ"
        unfolding β„Œ_def (*slow*)
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros 
          )
    qed 
      (
        use Ξ² Ξ±Ξ² in
          β€Ή
            cs_concl
              cs_simp: cat_FUNCT_cs_simps
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          β€Ί
      )+
    show "exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉)⦇ArrMap⦈ =
      (exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix 𝔑 assume "𝔑 ∈∘ cat_FUNCT Ξ± 𝔇 𝔄⦇Arr⦈"
      then obtain β„Œ β„Œ' where 𝔑: "𝔑 : β„Œ ↦cat_FUNCT Ξ± 𝔇 𝔄 β„Œ'" 
        by (auto intro: is_arrI)
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
      from assms 𝔑(1) Ξ² Ξ±Ξ² show 
        "exp_cat_cf Ξ± 𝔄 (π”Š ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ =
          (exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š)⦇ArrMapβ¦ˆβ¦‡π”‘β¦ˆ"
        by (subst (1 2) 𝔑(2))
          (
            cs_concl
              cs_simp:
                cat_FUNCT_cs_simps cat_cs_simps ntcf_cf_comp_ntcf_cf_comp_assoc
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed 
      (
        use Ξ² Ξ±Ξ² in
          β€Ή
            cs_concl
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          β€Ί
      )+
  qed simp_all

qed



subsectionβ€ΉNatural transformation raised to the power of a categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition exp_ntcf_cat :: "V β‡’ V β‡’ V β‡’ V"
  where "exp_ntcf_cat Ξ± 𝔑 𝔇 =
    [
      (
        Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± 𝔇 (𝔑⦇NTDGDom⦈)⦇Obj⦈.
          ntcf_arrow (𝔑 ∘NTCF-CF cf_of_cf_map 𝔇 (𝔑⦇NTDGDom⦈) 𝔖)
      ),
      exp_cf_cat Ξ± (𝔑⦇NTDom⦈) 𝔇,
      exp_cf_cat Ξ± (𝔑⦇NTCod⦈) 𝔇,
      cat_FUNCT Ξ± 𝔇 (𝔑⦇NTDGDom⦈),
      cat_FUNCT Ξ± 𝔇 (𝔑⦇NTDGCod⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma exp_ntcf_cat_components:
  shows "exp_ntcf_cat Ξ± 𝔑 𝔇⦇NTMap⦈ =
    (
      Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± 𝔇 (𝔑⦇NTDGDom⦈)⦇Obj⦈.
        ntcf_arrow (𝔑 ∘NTCF-CF cf_of_cf_map 𝔇 (𝔑⦇NTDGDom⦈) 𝔖)
    )"
    and "exp_ntcf_cat Ξ± 𝔑 𝔇⦇NTDom⦈ = exp_cf_cat Ξ± (𝔑⦇NTDom⦈) 𝔇"
    and "exp_ntcf_cat Ξ± 𝔑 𝔇⦇NTCod⦈ = exp_cf_cat Ξ± (𝔑⦇NTCod⦈) 𝔇"
    and "exp_ntcf_cat Ξ± 𝔑 𝔇⦇NTDGDom⦈ = cat_FUNCT Ξ± 𝔇 (𝔑⦇NTDGDom⦈)"
    and "exp_ntcf_cat Ξ± 𝔑 𝔇⦇NTDGCod⦈ = cat_FUNCT Ξ± 𝔇 (𝔑⦇NTDGCod⦈)"
  unfolding exp_ntcf_cat_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda exp_ntcf_cat_components(1)
  |vsv exp_ntcf_cat_components_NTMap_vsv[cat_FUNCT_cs_intros]|

context is_ntcf
begin

lemmas exp_ntcf_cat_components' = 
  exp_ntcf_cat_components[where Ξ±=Ξ± and 𝔑=𝔑, unfolded cat_cs_simps]

lemmas [cat_FUNCT_cs_simps] = exp_ntcf_cat_components'(2-5)

mk_VLambda exp_ntcf_cat_components(1)[where 𝔑=𝔑, unfolded cat_cs_simps]
  |vdomain exp_ntcf_cat_components_NTMap_vdomain[cat_FUNCT_cs_simps]|
  |app exp_ntcf_cat_components_NTMap_app[cat_FUNCT_cs_simps]|

end

lemmas [cat_FUNCT_cs_simps] = 
  is_ntcf.exp_ntcf_cat_components'(2-5)
  is_ntcf.exp_ntcf_cat_components_NTMap_vdomain
  is_ntcf.exp_ntcf_cat_components_NTMap_app


subsubsectionβ€Ή
Natural transformation raised to the power of a category 
is a natural transformation
β€Ί

lemma exp_ntcf_cat_is_tiny_ntcf:
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β" 
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "category Ξ± 𝔇"
  shows "exp_ntcf_cat Ξ± 𝔑 𝔇 :
    exp_cf_cat Ξ± 𝔉 𝔇 ↦CF.tiny exp_cf_cat Ξ± π”Š 𝔇 :
    cat_FUNCT Ξ± 𝔇 𝔄 ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔇 𝔅"
proof(rule is_tiny_ntcfI')

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(3))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(4))

  let ?exp_𝔑 = β€Ήexp_ntcf_cat Ξ± 𝔑 𝔇›
  let ?exp_𝔉 = β€Ήexp_cf_cat Ξ± 𝔉 𝔇›
  let ?exp_π”Š = β€Ήexp_cf_cat Ξ± π”Š 𝔇›

  from assms(1,2) show 
    "exp_cf_cat Ξ± 𝔉 𝔇 : cat_FUNCT Ξ± 𝔇 𝔄 ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔇 𝔅"
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(1,2) show 
    "exp_cf_cat Ξ± π”Š 𝔇 : cat_FUNCT Ξ± 𝔇 𝔄 ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔇 𝔅"
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

  show "?exp_𝔑 : 
    ?exp_𝔉 ↦CF ?exp_π”Š : cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔇 𝔅"
  proof(rule is_ntcfI')

    show "vfsequence (?exp_𝔑)" unfolding exp_ntcf_cat_def by auto
    show "vcard (?exp_𝔑) = 5β„•"
      unfolding exp_ntcf_cat_def by (simp add: nat_omega_simps)

    from assms(1,2) show "?exp_𝔉 : cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔇 𝔅"
      by 
        (
          cs_concl cs_intro: 
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from assms(1,2) show "?exp_π”Š : cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔇 𝔅"
      by 
        (
          cs_concl cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )

    show "?exp_𝔑⦇NTMapβ¦ˆβ¦‡β„Œβ¦ˆ : 
      ?exp_𝔉⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ ↦cat_FUNCT Ξ± 𝔇 𝔅 ?exp_π”Šβ¦‡ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ"
      if "β„Œ ∈∘ cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈" for β„Œ
    proof-
      from that[unfolded cat_FUNCT_cs_simps] have "β„Œ ∈∘ cf_maps Ξ± 𝔇 𝔄" by simp
      then obtain β„Œ' where β„Œ_def: "β„Œ = cf_map β„Œ'" and β„Œ': "β„Œ' : 𝔇 ↦↦CΞ± 𝔄" 
        by auto
      from β„Œ' show ?thesis
        by 
          (
            cs_concl 
              cs_simp: cat_FUNCT_cs_simps β„Œ_def 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
    
    show 
      "?exp_𝔑⦇NTMapβ¦ˆβ¦‡π”—β¦ˆ ∘Acat_FUNCT Ξ± 𝔇 𝔅 ?exp_𝔉⦇ArrMapβ¦ˆβ¦‡π”β¦ˆ =
        ?exp_π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”β¦ˆ ∘Acat_FUNCT Ξ± 𝔇 𝔅 ?exp_𝔑⦇NTMapβ¦ˆβ¦‡π”–β¦ˆ"
      if "𝔏 : 𝔖 ↦cat_FUNCT Ξ± 𝔇 𝔄 𝔗" for 𝔖 𝔗 𝔏
    proof-
      note 𝔏 = cat_FUNCT_is_arrD[OF that]
      let ?𝔖 = β€Ήcf_of_cf_map 𝔇 𝔄 𝔖›
        and ?𝔗 = β€Ήcf_of_cf_map 𝔇 𝔄 𝔗›
        and ?𝔏 = β€Ήntcf_of_ntcf_arrow 𝔇 𝔄 𝔏›
      have [cat_cs_simps]:
        "(𝔑 ∘NTCF-CF ?𝔗) βˆ™NTCF (𝔉 ∘CF-NTCF ?𝔏) =
          (π”Š ∘CF-NTCF ?𝔏) βˆ™NTCF (𝔑 ∘NTCF-CF ?𝔖)"
      proof(rule ntcf_eqI)
        from 𝔏(1) show
          "(𝔑 ∘NTCF-CF ?𝔗) βˆ™NTCF (𝔉 ∘CF-NTCF ?𝔏) :
            𝔉 ∘CF ?𝔖 ↦CF π”Š ∘CF ?𝔗 : 𝔇 ↦↦CΞ± 𝔅"
          by (cs_concl cs_intro: cat_cs_intros)
        from 𝔏(1) show
          "(π”Š ∘CF-NTCF ?𝔏) βˆ™NTCF (𝔑 ∘NTCF-CF ?𝔖) :
            𝔉 ∘CF ?𝔖 ↦CF π”Š ∘CF ?𝔗 : 𝔇 ↦↦CΞ± 𝔅"
          by (cs_concl cs_intro: cat_cs_intros)
        from 𝔏(1) have dom_lhs:
          "π’Ÿβˆ˜ (((𝔑 ∘NTCF-CF ?𝔗) βˆ™NTCF (𝔉 ∘CF-NTCF ?𝔏))⦇NTMap⦈) = 𝔇⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from 𝔏(1) have dom_rhs:
          "π’Ÿβˆ˜ (((π”Š ∘CF-NTCF ?𝔏) βˆ™NTCF (𝔑 ∘NTCF-CF ?𝔖))⦇NTMap⦈) = 𝔇⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show 
          "((𝔑 ∘NTCF-CF ?𝔗) βˆ™NTCF (𝔉 ∘CF-NTCF ?𝔏))⦇NTMap⦈ =
            ((π”Š ∘CF-NTCF ?𝔏) βˆ™NTCF (𝔑 ∘NTCF-CF ?𝔖))⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix d assume "d ∈∘ 𝔇⦇Obj⦈"
          with 𝔏(1) show
            "((𝔑 ∘NTCF-CF ?𝔗) βˆ™NTCF (𝔉 ∘CF-NTCF ?𝔏))⦇NTMapβ¦ˆβ¦‡d⦈ =
              ((π”Š ∘CF-NTCF ?𝔏) βˆ™NTCF (𝔑 ∘NTCF-CF ?𝔖))⦇NTMapβ¦ˆβ¦‡d⦈"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        qed (cs_concl cs_intro: cat_cs_intros)
      qed simp_all
      from 𝔏(1,3,4) that show ?thesis
        by (subst (1 2) 𝔏(2), use nothing in β€Ήsubst 𝔏(3), subst 𝔏(4)β€Ί)
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
  qed 
    (
      cs_concl 
        cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
    )+

qed

lemma exp_ntcf_cat_is_tiny_ntcf'[cat_FUNCT_cs_intros]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "category Ξ± 𝔇"
    and "𝔉' = exp_cf_cat Ξ± 𝔉 𝔇"
    and "π”Š' = exp_cf_cat Ξ± π”Š 𝔇"
    and "𝔄' = cat_FUNCT Ξ± 𝔇 𝔄"
    and "𝔅' = cat_FUNCT Ξ± 𝔇 𝔅"
  shows "exp_ntcf_cat Ξ± 𝔑 𝔇 : 𝔉' ↦CF.tiny π”Š' : 𝔄' ↦↦C.tinyΞ² 𝔅'"
  using assms(1-4) unfolding assms(5-8) by (rule exp_ntcf_cat_is_tiny_ntcf)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma exp_ntcf_cat_cf_ntcf_comp: 
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "category Ξ± 𝔇"
  shows 
    "exp_ntcf_cat Ξ± (β„Œ ∘CF-NTCF 𝔑) 𝔇 =
      exp_cf_cat Ξ± β„Œ 𝔇 ∘CF-NTCF exp_ntcf_cat Ξ± 𝔑 𝔇"
proof-

  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(3))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔑.𝒡_Limit_Ξ±Ο‰ 𝔑.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔑.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)
    from Ξ±Ξ² have dom_lhs:
      "π’Ÿβˆ˜ (exp_ntcf_cat Ξ± (β„Œ ∘CF-NTCF 𝔑) 𝔇⦇NTMap⦈) = cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have dom_rhs: 
      "π’Ÿβˆ˜ ((exp_cf_cat Ξ± β„Œ 𝔇 ∘CF-NTCF exp_ntcf_cat Ξ± 𝔑 𝔇)⦇NTMap⦈) =
        cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    show
      "exp_ntcf_cat Ξ± (β„Œ ∘CF-NTCF 𝔑) 𝔇⦇NTMap⦈ =
        (exp_cf_cat Ξ± β„Œ 𝔇 ∘CF-NTCF exp_ntcf_cat Ξ± 𝔑 𝔇)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix π”Ž assume prems: "π”Ž ∈∘ cf_maps Ξ± 𝔇 𝔄"
      then obtain π”Ž' where π”Ž_def: "π”Ž = cf_map π”Ž'" and π”Ž': "π”Ž' : 𝔇 ↦↦CΞ± 𝔄"
        by (auto intro: is_arrI)
      from Ξ±Ξ² prems π”Ž' show 
        "exp_ntcf_cat Ξ± (β„Œ ∘CF-NTCF 𝔑) 𝔇⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ =
          (exp_cf_cat Ξ± β„Œ 𝔇 ∘CF-NTCF exp_ntcf_cat Ξ± 𝔑 𝔇)⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ"
        by 
          (
            cs_concl
              cs_simp:
                cf_ntcf_comp_ntcf_cf_comp_assoc 
                cat_cs_simps cat_FUNCT_cs_simps
                π”Ž_def
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  qed
    (
      cs_concl
        cs_simp: exp_cf_cat_cf_comp cat_cs_simps cat_FUNCT_cs_simps
        cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
    )+

qed

lemma exp_ntcf_cat_ntcf_cf_comp: 
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "β„Œ : 𝔄 ↦↦CΞ± 𝔅"
    and "category Ξ± 𝔇"
  shows 
    "exp_ntcf_cat Ξ± (𝔑 ∘NTCF-CF β„Œ) 𝔇 =
      exp_ntcf_cat Ξ± 𝔑 𝔇 ∘NTCF-CF exp_cf_cat Ξ± β„Œ 𝔇"
proof-

  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔄 𝔅 β„Œ by (rule assms(2))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(3))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔑.𝒡_Limit_Ξ±Ο‰ 𝔑.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔑.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)
    from Ξ±Ξ² have dom_lhs:
      "π’Ÿβˆ˜ (exp_ntcf_cat Ξ± (𝔑 ∘NTCF-CF β„Œ) 𝔇⦇NTMap⦈) = cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have dom_rhs: 
      "π’Ÿβˆ˜ ((exp_ntcf_cat Ξ± 𝔑 𝔇 ∘NTCF-CF exp_cf_cat Ξ± β„Œ 𝔇)⦇NTMap⦈) =
        cat_FUNCT Ξ± 𝔇 𝔄⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    show
      "exp_ntcf_cat Ξ± (𝔑 ∘NTCF-CF β„Œ) 𝔇⦇NTMap⦈ =
        (exp_ntcf_cat Ξ± 𝔑 𝔇 ∘NTCF-CF exp_cf_cat Ξ± β„Œ 𝔇)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix π”Ž assume prems: "π”Ž ∈∘ cf_maps Ξ± 𝔇 𝔄"
      then obtain π”Ž' where π”Ž_def: "π”Ž = cf_map π”Ž'" and π”Ž': "π”Ž' : 𝔇 ↦↦CΞ± 𝔄"
        by (auto intro: is_arrI)
      from Ξ±Ξ² assms prems π”Ž' show
        "exp_ntcf_cat Ξ± (𝔑 ∘NTCF-CF β„Œ) 𝔇⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ = 
          (exp_ntcf_cat Ξ± 𝔑 𝔇 ∘NTCF-CF exp_cf_cat Ξ± β„Œ 𝔇)⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ"
        by 
          (
            cs_concl 
              cs_simp: 
                ntcf_cf_comp_ntcf_cf_comp_assoc 
                cat_cs_simps cat_FUNCT_cs_simps 
                π”Ž_def
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  qed
    (
      cs_concl
        cs_simp: exp_cf_cat_cf_comp cat_cs_simps cat_FUNCT_cs_simps
        cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
    )+
qed

lemma exp_ntcf_cat_ntcf_vcomp: 
  assumes "category Ξ± 𝔄" 
    and "𝔐 : π”Š ↦CF β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
  shows 
    "exp_ntcf_cat Ξ± (𝔐 βˆ™NTCF 𝔑) 𝔄 =
      exp_ntcf_cat Ξ± 𝔐 𝔄 βˆ™NTCF exp_ntcf_cat Ξ± 𝔑 𝔄"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ π”Š β„Œ 𝔐 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(3))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)
    from Ξ±Ξ² show
      "exp_ntcf_cat Ξ± (𝔐 βˆ™NTCF 𝔑) 𝔄 :
        exp_cf_cat Ξ± 𝔉 𝔄 ↦CF exp_cf_cat Ξ± β„Œ 𝔄 :
        cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² show
      "exp_ntcf_cat Ξ± 𝔐 𝔄 βˆ™NTCF exp_ntcf_cat Ξ± 𝔑 𝔄 :
        exp_cf_cat Ξ± 𝔉 𝔄 ↦CF exp_cf_cat Ξ± β„Œ 𝔄 :
        cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have dom_lhs: 
      "π’Ÿβˆ˜ ((exp_ntcf_cat Ξ± 𝔐 𝔄 βˆ™NTCF exp_ntcf_cat Ξ± 𝔑 𝔄)⦇NTMap⦈) = 
        cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    have dom_rhs: 
      "π’Ÿβˆ˜ (exp_ntcf_cat Ξ± (𝔐 βˆ™NTCF 𝔑) 𝔄⦇NTMap⦈) = cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
    show 
      "exp_ntcf_cat Ξ± (𝔐 βˆ™NTCF 𝔑) 𝔄⦇NTMap⦈ = 
        (exp_ntcf_cat Ξ± 𝔐 𝔄 βˆ™NTCF exp_ntcf_cat Ξ± 𝔑 𝔄)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix 𝔉' assume "𝔉' ∈∘ cf_maps Ξ± 𝔄 𝔅"
      then obtain 𝔉'' 
        where 𝔉'_def: "𝔉' = cf_map 𝔉''" and 𝔉'': "𝔉'' : 𝔄 ↦↦CΞ± 𝔅" 
        by auto
      from 𝔉'' Ξ±Ξ² show 
        "exp_ntcf_cat Ξ± (𝔐 βˆ™NTCF 𝔑) 𝔄⦇NTMapβ¦ˆβ¦‡π”‰'⦈ =
          (exp_ntcf_cat Ξ± 𝔐 𝔄 βˆ™NTCF exp_ntcf_cat Ξ± 𝔑 𝔄)⦇NTMapβ¦ˆβ¦‡π”‰'⦈"
        unfolding 𝔉'_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
  qed simp_all

qed

lemma ntcf_id_exp_cf_cat:
  assumes "category Ξ± 𝔄" and "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "ntcf_id (exp_cf_cat Ξ± 𝔉 𝔄) = exp_ntcf_cat Ξ± (ntcf_id 𝔉) 𝔄"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(2))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)
    from Ξ±Ξ² show "exp_ntcf_cat Ξ± (ntcf_id 𝔉) 𝔄 :
      exp_cf_cat Ξ± 𝔉 𝔄 ↦CF exp_cf_cat Ξ± 𝔉 𝔄 :
      cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² show "ntcf_id (exp_cf_cat Ξ± 𝔉 𝔄) :
      exp_cf_cat Ξ± 𝔉 𝔄 ↦CF exp_cf_cat Ξ± 𝔉 𝔄 :
      cat_FUNCT Ξ± 𝔄 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² assms have dom_lhs: 
      "π’Ÿβˆ˜ (ntcf_id (exp_cf_cat Ξ± 𝔉 𝔄)⦇NTMap⦈) = cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² assms have dom_rhs:
      "π’Ÿβˆ˜ (exp_ntcf_cat Ξ± (ntcf_id 𝔉) 𝔄⦇NTMap⦈) = cat_FUNCT Ξ± 𝔄 𝔅⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    show
      "ntcf_id (exp_cf_cat Ξ± 𝔉 𝔄)⦇NTMap⦈ = exp_ntcf_cat Ξ± (ntcf_id 𝔉) 𝔄⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix π”Š assume "π”Š ∈∘ cf_maps Ξ± 𝔄 𝔅"
      then obtain π”Š' 
        where π”Š_def: "π”Š = cf_map π”Š'" and π”Š': "π”Š' : 𝔄 ↦↦CΞ± 𝔅" 
        by auto  
      from π”Š' Ξ±Ξ² show 
        "ntcf_id (exp_cf_cat Ξ± 𝔉 𝔄)⦇NTMapβ¦ˆβ¦‡π”Šβ¦ˆ =
          exp_ntcf_cat Ξ± (ntcf_id 𝔉) 𝔄⦇NTMapβ¦ˆβ¦‡π”Šβ¦ˆ"
        unfolding π”Š_def
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed 
      (
        cs_concl 
          cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )+
  qed simp_all
qed



subsectionβ€ΉCategory raised to the power of the natural transformationβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition exp_cat_ntcf :: "V β‡’ V β‡’ V β‡’ V"
  where "exp_cat_ntcf Ξ± β„­ 𝔑 =
    [
      (
        Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± (𝔑⦇NTDGCod⦈) ℭ⦇Obj⦈.
          ntcf_arrow (cf_of_cf_map (𝔑⦇NTDGCod⦈) β„­ 𝔖 ∘CF-NTCF 𝔑)
      ),
      exp_cat_cf Ξ± β„­ (𝔑⦇NTDom⦈),
      exp_cat_cf Ξ± β„­ (𝔑⦇NTCod⦈),
      cat_FUNCT Ξ± (𝔑⦇NTDGCod⦈) β„­,
      cat_FUNCT Ξ± (𝔑⦇NTDGDom⦈) β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma exp_cat_ntcf_components:
  shows "exp_cat_ntcf Ξ± β„­ 𝔑⦇NTMap⦈ =
    (
      Ξ»π”–βˆˆβˆ˜cat_FUNCT Ξ± (𝔑⦇NTDGCod⦈) ℭ⦇Obj⦈.
        ntcf_arrow (cf_of_cf_map (𝔑⦇NTDGCod⦈) β„­ 𝔖 ∘CF-NTCF 𝔑)
    )"
    and "exp_cat_ntcf Ξ± β„­ 𝔑⦇NTDom⦈ = exp_cat_cf Ξ± β„­ (𝔑⦇NTDom⦈)"
    and "exp_cat_ntcf Ξ± β„­ 𝔑⦇NTCod⦈ = exp_cat_cf Ξ± β„­ (𝔑⦇NTCod⦈)"
    and "exp_cat_ntcf Ξ± β„­ 𝔑⦇NTDGDom⦈ = cat_FUNCT Ξ± (𝔑⦇NTDGCod⦈) β„­"
    and "exp_cat_ntcf Ξ± β„­ 𝔑⦇NTDGCod⦈ = cat_FUNCT Ξ± (𝔑⦇NTDGDom⦈) β„­"
  unfolding exp_cat_ntcf_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda exp_cat_ntcf_components(1)
  |vsv exp_cat_ntcf_components_NTMap_vsv[cat_FUNCT_cs_intros]|

context is_ntcf
begin

lemmas exp_cat_ntcf_components' = 
  exp_cat_ntcf_components[where Ξ±=Ξ± and 𝔑=𝔑, unfolded cat_cs_simps]

lemmas [cat_FUNCT_cs_simps] = exp_cat_ntcf_components'(2-5)

mk_VLambda exp_cat_ntcf_components(1)[where 𝔑=𝔑, unfolded cat_cs_simps]
  |vdomain exp_cat_ntcf_components_NTMap_vdomain[cat_FUNCT_cs_simps]|
  |app exp_cat_ntcf_components_NTMap_app[cat_FUNCT_cs_simps]|

end

lemmas exp_cat_ntcf_components' = is_ntcf.exp_cat_ntcf_components'

lemmas [cat_FUNCT_cs_simps] = 
  is_ntcf.exp_cat_ntcf_components'(2-5)
  is_ntcf.exp_cat_ntcf_components_NTMap_vdomain
  is_ntcf.exp_cat_ntcf_components_NTMap_app


subsubsectionβ€Ή
Category raised to the power of a natural transformation
is a natural transformation
β€Ί

lemma exp_cat_ntcf_is_tiny_ntcf:
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β" 
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "category Ξ± β„­"
  shows "exp_cat_ntcf Ξ± β„­ 𝔑 :
    exp_cat_cf Ξ± β„­ 𝔉 ↦CF.tiny exp_cat_cf Ξ± β„­ π”Š :
    cat_FUNCT Ξ± 𝔅 β„­ ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔄 β„­"
proof(rule is_tiny_ntcfI')

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(3))
  interpret β„­: category Ξ± β„­ by (rule assms(4))

  let ?exp_𝔑 = β€Ήexp_cat_ntcf Ξ± β„­ 𝔑›
  let ?exp_𝔉 = β€Ήexp_cat_cf Ξ± β„­ 𝔉›
  let ?exp_π”Š = β€Ήexp_cat_cf Ξ± β„­ π”Šβ€Ί

  from assms(1,2) show
    "exp_cat_cf Ξ± β„­ π”Š : cat_FUNCT Ξ± 𝔅 β„­ ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔄 β„­"
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(1,2) show
    "exp_cat_cf Ξ± β„­ 𝔉 : cat_FUNCT Ξ± 𝔅 β„­ ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔄 β„­"
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

  show "?exp_𝔑 : ?exp_𝔉 ↦CF ?exp_π”Š : cat_FUNCT Ξ± 𝔅 β„­ ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
  proof(rule is_ntcfI')

    show "vfsequence (?exp_𝔑)" unfolding exp_cat_ntcf_def by auto
    show "vcard (?exp_𝔑) = 5β„•"
      unfolding exp_cat_ntcf_def by (simp add: nat_omega_simps)
  
    from assms(1,2) show
      "exp_cat_cf Ξ± β„­ π”Š : cat_FUNCT Ξ± 𝔅 β„­ ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )

    from assms(1,2) show 
      "exp_cat_cf Ξ± β„­ 𝔉 : cat_FUNCT Ξ± 𝔅 β„­ ↦↦CΞ² cat_FUNCT Ξ± 𝔄 β„­"
      by 
        (
          cs_concl cs_intro: 
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
  
    show "exp_cat_ntcf Ξ± β„­ 𝔑⦇NTMapβ¦ˆβ¦‡β„Œβ¦ˆ : 
      exp_cat_cf Ξ± β„­ 𝔉⦇ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ ↦cat_FUNCT Ξ± 𝔄 β„­ 
      exp_cat_cf Ξ± β„­ π”Šβ¦‡ObjMapβ¦ˆβ¦‡β„Œβ¦ˆ"
      if "β„Œ ∈∘ cat_FUNCT Ξ± 𝔅 ℭ⦇Obj⦈" for β„Œ
    proof-
      from that[unfolded cat_FUNCT_cs_simps] have "β„Œ ∈∘ cf_maps Ξ± 𝔅 β„­" by simp
      then obtain β„Œ' where β„Œ_def: "β„Œ = cf_map β„Œ'" and β„Œ': "β„Œ' : 𝔅 ↦↦CΞ± β„­" 
        by auto
      from β„Œ' show ?thesis
        unfolding β„Œ_def
        by
          (
            cs_concl
              cs_simp: cat_FUNCT_cs_simps β„Œ_def
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
  
    show 
      "?exp_𝔑⦇NTMapβ¦ˆβ¦‡π”—β¦ˆ ∘Acat_FUNCT Ξ± 𝔄 β„­ ?exp_𝔉⦇ArrMapβ¦ˆβ¦‡π”β¦ˆ =
        ?exp_π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”β¦ˆ ∘Acat_FUNCT Ξ± 𝔄 β„­ ?exp_𝔑⦇NTMapβ¦ˆβ¦‡π”–β¦ˆ"
      if "𝔏 : 𝔖 ↦cat_FUNCT Ξ± 𝔅 β„­ 𝔗" for 𝔖 𝔗 𝔏
    proof-
      note 𝔏 = cat_FUNCT_is_arrD[OF that]
      let ?𝔖 = β€Ήcf_of_cf_map 𝔅 β„­ 𝔖›
        and ?𝔗 = β€Ήcf_of_cf_map 𝔅 β„­ 𝔗›
        and ?𝔏 = β€Ήntcf_of_ntcf_arrow 𝔅 β„­ 𝔏›
      have [cat_cs_simps]:
        "(?𝔗 ∘CF-NTCF 𝔑) βˆ™NTCF (?𝔏 ∘NTCF-CF 𝔉) =
          (?𝔏 ∘NTCF-CF π”Š) βˆ™NTCF (?𝔖 ∘CF-NTCF 𝔑)"
      proof(rule ntcf_eqI)
        from 𝔏(1) show
          "(?𝔗 ∘CF-NTCF 𝔑) βˆ™NTCF (?𝔏 ∘NTCF-CF 𝔉) :
            ?𝔖 ∘CF 𝔉 ↦CF ?𝔗 ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
          by (cs_concl cs_intro: cat_cs_intros)
        from 𝔏(1) show
          "(?𝔏 ∘NTCF-CF π”Š) βˆ™NTCF (?𝔖 ∘CF-NTCF 𝔑) :
            ?𝔖 ∘CF 𝔉 ↦CF ?𝔗 ∘CF π”Š : 𝔄 ↦↦CΞ± β„­"
          by (cs_concl cs_intro: cat_cs_intros)
        from 𝔏(1) have dom_lhs:
          "π’Ÿβˆ˜ (((?𝔗 ∘CF-NTCF 𝔑) βˆ™NTCF (?𝔏 ∘NTCF-CF 𝔉))⦇NTMap⦈) = 𝔄⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from 𝔏(1) have dom_rhs:
          "π’Ÿβˆ˜ (((?𝔏 ∘NTCF-CF π”Š) βˆ™NTCF (?𝔖 ∘CF-NTCF 𝔑))⦇NTMap⦈) = 𝔄⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show 
          "((?𝔗 ∘CF-NTCF 𝔑) βˆ™NTCF (?𝔏 ∘NTCF-CF 𝔉))⦇NTMap⦈ =
            ((?𝔏 ∘NTCF-CF π”Š) βˆ™NTCF (?𝔖 ∘CF-NTCF 𝔑))⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume "a ∈∘ 𝔄⦇Obj⦈"
          with 𝔏(1) show
            "((?𝔗 ∘CF-NTCF 𝔑) βˆ™NTCF (?𝔏 ∘NTCF-CF 𝔉))⦇NTMapβ¦ˆβ¦‡a⦈ =
              ((?𝔏 ∘NTCF-CF π”Š) βˆ™NTCF (?𝔖 ∘CF-NTCF 𝔑))⦇NTMapβ¦ˆβ¦‡a⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps is_ntcf.ntcf_Comp_commute 
                  cs_intro: cat_cs_intros
              )
        qed (cs_concl cs_intro: cat_cs_intros)
      qed simp_all
      from 𝔏(1,3,4) that show ?thesis
        by (subst (1 2) 𝔏(2), use nothing in β€Ήsubst 𝔏(3), subst 𝔏(4)β€Ί)
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed

  qed
    (
      cs_concl 
        cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
    )+

qed

lemma exp_cat_ntcf_is_tiny_ntcf'[cat_FUNCT_cs_intros]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "category Ξ± β„­"
    and "𝔉' = exp_cat_cf Ξ± β„­ 𝔉"
    and "π”Š' = exp_cat_cf Ξ± β„­ π”Š"
    and "𝔄' = cat_FUNCT Ξ± 𝔅 β„­"
    and "𝔅' = cat_FUNCT Ξ± 𝔄 β„­"
  shows "exp_cat_ntcf Ξ± β„­ 𝔑 : 𝔉' ↦CF.tiny π”Š' : 𝔄' ↦↦C.tinyΞ² 𝔅'"
  using assms(1-4) unfolding assms(5-8) by (rule exp_cat_ntcf_is_tiny_ntcf)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma ntcf_id_exp_cat_cf:
  assumes "category Ξ± 𝔄" and "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "ntcf_id (exp_cat_cf Ξ± 𝔄 𝔉) = exp_cat_ntcf Ξ± 𝔄 (ntcf_id 𝔉)"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(2))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)
    from Ξ±Ξ² show "exp_cat_ntcf Ξ± 𝔄 (ntcf_id 𝔉) :
      exp_cat_cf Ξ± 𝔄 𝔉 ↦CF exp_cat_cf Ξ± 𝔄 𝔉 :
      cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔅 𝔄"
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from assms Ξ² Ξ±Ξ² show "ntcf_id (exp_cat_cf Ξ± 𝔄 𝔉) :
      exp_cat_cf Ξ± 𝔄 𝔉 ↦CF exp_cat_cf Ξ± 𝔄 𝔉 :
      cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔅 𝔄"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² assms have dom_lhs: 
      "π’Ÿβˆ˜ (exp_cat_ntcf Ξ± 𝔄 (ntcf_id 𝔉)⦇NTMap⦈) = cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² assms have dom_rhs:
      "π’Ÿβˆ˜ (ntcf_id (exp_cat_cf Ξ± 𝔄 𝔉)⦇NTMap⦈) = cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        )
    show
      "ntcf_id (exp_cat_cf Ξ± 𝔄 𝔉)⦇NTMap⦈ = exp_cat_ntcf Ξ± 𝔄 (ntcf_id 𝔉)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix π”Š assume "π”Š ∈∘ cf_maps Ξ± β„­ 𝔄"
      then obtain π”Š' 
        where π”Š_def: "π”Š = cf_map π”Š'" and π”Š': "π”Š' : β„­ ↦↦CΞ± 𝔄" 
        by auto  
      from π”Š' Ξ±Ξ² show 
        "ntcf_id (exp_cat_cf Ξ± 𝔄 𝔉)⦇NTMapβ¦ˆβ¦‡π”Šβ¦ˆ =
          exp_cat_ntcf Ξ± 𝔄 (ntcf_id 𝔉)⦇NTMapβ¦ˆβ¦‡π”Šβ¦ˆ"
        unfolding π”Š_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_FUNCT_cs_simps
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed 
      (
        cs_concl 
          cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )+
  qed simp_all

qed

lemma exp_cat_ntcf_ntcf_cf_comp:
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "β„Œ : 𝔄 ↦↦CΞ± 𝔅"
    and "category Ξ± 𝔇"
  shows 
    "exp_cat_ntcf Ξ± 𝔇 (𝔑 ∘NTCF-CF β„Œ) =
      exp_cat_cf Ξ± 𝔇 β„Œ ∘CF-NTCF exp_cat_ntcf Ξ± 𝔇 𝔑"
proof-

  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔄 𝔅 β„Œ by (rule assms(2))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(3))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔑.𝒡_Limit_Ξ±Ο‰ 𝔑.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔑.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)
    from Ξ±Ξ² have dom_lhs:
      "π’Ÿβˆ˜ (exp_cat_ntcf Ξ± 𝔇 (𝔑 ∘NTCF-CF β„Œ)⦇NTMap⦈) = cat_FUNCT Ξ± β„­ 𝔇⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have dom_rhs: 
      "π’Ÿβˆ˜ ((exp_cat_cf Ξ± 𝔇 β„Œ ∘CF-NTCF exp_cat_ntcf Ξ± 𝔇 𝔑)⦇NTMap⦈) =
        cat_FUNCT Ξ± β„­ 𝔇⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )

    show
      "exp_cat_ntcf Ξ± 𝔇 (𝔑 ∘NTCF-CF β„Œ)⦇NTMap⦈ =
        (exp_cat_cf Ξ± 𝔇 β„Œ ∘CF-NTCF exp_cat_ntcf Ξ± 𝔇 𝔑)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix π”Ž assume prems: "π”Ž ∈∘ cf_maps Ξ± β„­ 𝔇"
      then obtain π”Ž' where π”Ž_def: "π”Ž = cf_map π”Ž'" and π”Ž': "π”Ž' : β„­ ↦↦CΞ± 𝔇"
        by (auto intro: is_arrI)
      from Ξ±Ξ² assms prems π”Ž' show
        "exp_cat_ntcf Ξ± 𝔇 (𝔑 ∘NTCF-CF β„Œ)⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ = 
          (exp_cat_cf Ξ± 𝔇 β„Œ ∘CF-NTCF exp_cat_ntcf Ξ± 𝔇 𝔑)⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ"
        unfolding π”Ž_def
        by
          (
            cs_concl
              cs_simp:
                cf_ntcf_comp_ntcf_cf_comp_assoc cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  qed
    (
      cs_concl
        cs_simp: exp_cat_cf_cf_comp cat_cs_simps cat_FUNCT_cs_simps
        cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
    )+

qed

lemma exp_cat_ntcf_cf_ntcf_comp: 
  assumes "𝔑 : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± 𝔅"
    and "β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "category Ξ± 𝔇"
  shows
    "exp_cat_ntcf Ξ± 𝔇 (β„Œ ∘CF-NTCF 𝔑) =
      exp_cat_ntcf Ξ± 𝔇 𝔑 ∘NTCF-CF exp_cat_cf Ξ± 𝔇 β„Œ"
proof-

  interpret 𝔑: is_ntcf Ξ± 𝔄 𝔅 𝔉 π”Š 𝔑 by (rule assms(1))
  interpret β„Œ: is_functor Ξ± 𝔅 β„­ β„Œ by (rule assms(2))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(3))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔑.𝒡_Limit_Ξ±Ο‰ 𝔑.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔑.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)

    from Ξ±Ξ² have dom_lhs:
      "π’Ÿβˆ˜ (exp_cat_ntcf Ξ± 𝔇 (β„Œ ∘CF-NTCF 𝔑)⦇NTMap⦈) = cat_FUNCT Ξ± β„­ 𝔇⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have dom_rhs: 
      "π’Ÿβˆ˜ ((exp_cat_ntcf Ξ± 𝔇 𝔑 ∘NTCF-CF exp_cat_cf Ξ± 𝔇 β„Œ)⦇NTMap⦈) =
        cat_FUNCT Ξ± β„­ 𝔇⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )

    show
      "exp_cat_ntcf Ξ± 𝔇 (β„Œ ∘CF-NTCF 𝔑)⦇NTMap⦈ =
        (exp_cat_ntcf Ξ± 𝔇 𝔑 ∘NTCF-CF exp_cat_cf Ξ± 𝔇 β„Œ)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix π”Ž assume prems: "π”Ž ∈∘ cf_maps Ξ± β„­ 𝔇"
      then obtain π”Ž' where π”Ž_def: "π”Ž = cf_map π”Ž'" and π”Ž': "π”Ž' : β„­ ↦↦CΞ± 𝔇"
        by (auto intro: is_arrI)
      from assms Ξ±Ξ² prems π”Ž' show
        "exp_cat_ntcf Ξ± 𝔇 (β„Œ ∘CF-NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ =
          (exp_cat_ntcf Ξ± 𝔇 𝔑 ∘NTCF-CF exp_cat_cf Ξ± 𝔇 β„Œ)⦇NTMapβ¦ˆβ¦‡π”Žβ¦ˆ"
        by 
          (
            cs_concl 
              cs_simp: 
                cf_comp_cf_ntcf_comp_assoc cat_cs_simps cat_FUNCT_cs_simps π”Ž_def
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

  qed
    (
      cs_concl
        cs_simp: exp_cat_cf_cf_comp cat_cs_simps cat_FUNCT_cs_simps
        cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
    )+

qed

lemma exp_cat_ntcf_ntcf_vcomp:
  assumes "category Ξ± 𝔄" 
    and "𝔐 : π”Š ↦CF β„Œ : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
  shows
    "exp_cat_ntcf Ξ± 𝔄 (𝔐 βˆ™NTCF 𝔑) =
      exp_cat_ntcf Ξ± 𝔄 𝔐 βˆ™NTCF exp_cat_ntcf Ξ± 𝔄 𝔑"
proof-

  interpret 𝔄: category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔐: is_ntcf Ξ± 𝔅 β„­ π”Š β„Œ 𝔐 by (rule assms(2))
  interpret 𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š 𝔑 by (rule assms(3))

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝔄.𝒡_Limit_Ξ±Ο‰ 𝔄.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝔄.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  show ?thesis
  proof(rule ntcf_eqI)
    from Ξ² Ξ±Ξ² show
      "exp_cat_ntcf Ξ± 𝔄 (𝔐 βˆ™NTCF 𝔑) :
        exp_cat_cf Ξ± 𝔄 𝔉 ↦CF exp_cat_cf Ξ± 𝔄 β„Œ :
        cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔅 𝔄"
      by
        (
          cs_concl cs_intro: 
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² show
      "exp_cat_ntcf Ξ± 𝔄 𝔐 βˆ™NTCF exp_cat_ntcf Ξ± 𝔄 𝔑 :
        exp_cat_cf Ξ± 𝔄 𝔉 ↦CF exp_cat_cf Ξ± 𝔄 β„Œ :
        cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔅 𝔄"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have dom_lhs: 
      "π’Ÿβˆ˜ ((exp_cat_ntcf Ξ± 𝔄 (𝔐 βˆ™NTCF 𝔑))⦇NTMap⦈) = cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from Ξ±Ξ² have dom_rhs:
      "π’Ÿβˆ˜ ((exp_cat_ntcf Ξ± 𝔄 𝔐 βˆ™NTCF exp_cat_ntcf Ξ± 𝔄 𝔑)⦇NTMap⦈) =
        cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )

    show 
      "exp_cat_ntcf Ξ± 𝔄 (𝔐 βˆ™NTCF 𝔑)⦇NTMap⦈ =
        (exp_cat_ntcf Ξ± 𝔄 𝔐 βˆ™NTCF exp_cat_ntcf Ξ± 𝔄 𝔑)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
      fix 𝔉' assume "𝔉' ∈∘ cf_maps Ξ± β„­ 𝔄"
      then obtain 𝔉'' 
        where 𝔉'_def: "𝔉' = cf_map 𝔉''" and 𝔉'': "𝔉'' : β„­ ↦↦CΞ± 𝔄" 
        by clarsimp
      from 𝔉'' Ξ±Ξ² show
        "exp_cat_ntcf Ξ± 𝔄 (𝔐 βˆ™NTCF 𝔑)⦇NTMapβ¦ˆβ¦‡π”‰'⦈ =
          (exp_cat_ntcf Ξ± 𝔄 𝔐 βˆ™NTCF exp_cat_ntcf Ξ± 𝔄 𝔑)⦇NTMapβ¦ˆβ¦‡π”‰'⦈"
        by
          (
            cs_concl
              cs_simp:
                cat_cs_simps cat_FUNCT_cs_simps cf_ntcf_comp_ntcf_vcomp 𝔉'_def
              cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
          )
    qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+

  qed simp_all

qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Hom

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€Ήβ€ΉHomβ€Ί-functorβ€Ί
theory CZH_ECAT_Hom
  imports 
    CZH_ECAT_Set
    CZH_ECAT_PCategory
begin



subsectionβ€Ήβ€Ήhomβ€Ί-functionβ€Ί


textβ€Ή
The β€Ήhomβ€Ί-function is a part of the definition of the β€ΉHomβ€Ί-functor,
as presented in \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/hom-functor
}}.
β€Ί

definition cf_hom :: "V β‡’ V β‡’ V"
  where "cf_hom β„­ f =
    [
      (
        Ξ»q∈∘Hom β„­ (ℭ⦇Codβ¦ˆβ¦‡vpfst f⦈) (ℭ⦇Domβ¦ˆβ¦‡vpsnd f⦈).
          vpsnd f ∘Aβ„­ q ∘Aβ„­ vpfst f
      ),
      Hom β„­ (ℭ⦇Codβ¦ˆβ¦‡vpfst f⦈) (ℭ⦇Domβ¦ˆβ¦‡vpsnd f⦈),
      Hom β„­ (ℭ⦇Domβ¦ˆβ¦‡vpfst f⦈) (ℭ⦇Codβ¦ˆβ¦‡vpsnd f⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_hom_components:
  shows "cf_hom β„­ f⦇ArrVal⦈ = 
      (
        Ξ»q∈∘Hom β„­ (ℭ⦇Codβ¦ˆβ¦‡vpfst f⦈) (ℭ⦇Domβ¦ˆβ¦‡vpsnd f⦈). 
          vpsnd f ∘Aβ„­ q ∘Aβ„­ vpfst f
      )"
    and "cf_hom β„­ f⦇ArrDom⦈ = Hom β„­ (ℭ⦇Codβ¦ˆβ¦‡vpfst f⦈) (ℭ⦇Domβ¦ˆβ¦‡vpsnd f⦈)"
    and "cf_hom β„­ f⦇ArrCod⦈ = Hom β„­ (ℭ⦇Domβ¦ˆβ¦‡vpfst f⦈) (ℭ⦇Codβ¦ˆβ¦‡vpsnd f⦈)"
  unfolding cf_hom_def arr_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda cf_hom_components(1)
  |vsv cf_hom_ArrVal_vsv[cat_cs_intros]|

lemma cf_hom_ArrVal_vdomain[cat_cs_simps]:
  assumes "g : a ↦op_cat β„­ b" and "f : a' ↦ℭ b'"
  shows "π’Ÿβˆ˜ (cf_hom β„­ [g, f]βˆ˜β¦‡ArrVal⦈) = Hom β„­ a a'"
  using assms 
  unfolding cf_hom_components
  by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)

lemma cf_hom_ArrVal_app[cat_cs_simps]:
  assumes "g : c ↦op_cat β„­ d" and "q : c ↦ℭ c'" and "f : c' ↦ℭ d'"
  shows "cf_hom β„­ [g, f]βˆ˜β¦‡ArrValβ¦ˆβ¦‡q⦈ = f ∘Aβ„­ q ∘Aβ„­ g"
  using assms 
  unfolding cf_hom_components
  by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)

lemma (in category) cf_hom_ArrVal_vrange:
  assumes "g : a ↦op_cat β„­ b" and "f : a' ↦ℭ b'"
  shows "β„›βˆ˜ (cf_hom β„­ [g, f]βˆ˜β¦‡ArrVal⦈) βŠ†βˆ˜ Hom β„­ b b'"
proof(intro vsubsetI)
  interpret gf: vsv β€Ήcf_hom β„­ [g, f]βˆ˜β¦‡ArrValβ¦ˆβ€Ί 
    unfolding cf_hom_components by auto
  fix y assume "y ∈∘ β„›βˆ˜ (cf_hom β„­ [g, f]βˆ˜β¦‡ArrVal⦈)"
  then obtain q where y_def: "y = cf_hom β„­ [g, f]βˆ˜β¦‡ArrValβ¦ˆβ¦‡q⦈"
    and "q ∈∘ π’Ÿβˆ˜ (cf_hom β„­ [g, f]βˆ˜β¦‡ArrVal⦈)"
    by (metis gf.vrange_atD)
  then have q: "q : a ↦ℭ a'" 
    unfolding cf_hom_ArrVal_vdomain[OF assms] by simp
  from assms q show "y ∈∘ Hom β„­ b b'"
    unfolding y_def cf_hom_ArrVal_app[OF assms(1) q assms(2)] cat_op_simps 
    by (auto intro: cat_cs_intros)
qed


subsubsectionβ€ΉArrow domainβ€Ί

lemma (in category) cf_hom_ArrDom:
  assumes "gf : [c, c']∘ ↦op_cat β„­ Γ—C β„­ dd'"
  shows "cf_hom β„­ gf⦇ArrDom⦈ = Hom β„­ c c'"
proof-
  from assms obtain g f d d' 
    where "gf = [g, f]∘" and "g : c ↦op_cat β„­ d" and "f : c' ↦ℭ d'"
    unfolding cf_hom_components 
    by (elim cat_prod_2_is_arrE[rotated 2]) (auto intro: cat_cs_intros)
  then show ?thesis
    unfolding cf_hom_components 
    by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)
qed

lemmas [cat_cs_simps] = category.cf_hom_ArrDom


subsubsectionβ€ΉArrow codomainβ€Ί

lemma (in category) cf_hom_ArrCod:
  assumes "gf : cc' ↦op_cat β„­ Γ—C β„­ [d, d']∘"
  shows "cf_hom β„­ gf⦇ArrCod⦈ = Hom β„­ d d'"
proof-
  from assms obtain g f c c' 
    where "gf = [g, f]∘" and "g : c ↦op_cat β„­ d" and "f : c' ↦ℭ d'"
    unfolding cf_hom_components 
    by (elim cat_prod_2_is_arrE[rotated 2]) (auto intro: cat_cs_intros)
  then show ?thesis
    unfolding cf_hom_components 
    by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)
qed

lemmas [cat_cs_simps] = category.cf_hom_ArrCod


subsubsectionβ€Ήβ€Ήhomβ€Ί-function is an arrow in the category β€ΉSetβ€Ίβ€Ί

lemma (in category) cat_cf_hom_ArrRel:
  assumes "gf : cc' ↦op_cat β„­ Γ—C β„­ dd'"
  shows "arr_Set Ξ± (cf_hom β„­ gf)"
proof(intro arr_SetI)
  from assms obtain g f c c' d d'
    where gf_def: "gf = [g, f]∘"
      and cc'_def: "cc' = [c, c']∘"
      and dd'_def: "dd' = [d, d']∘"
      and op_g: "g : c ↦op_cat β„­ d" 
      and f: "f : c' ↦ℭ d'"
    unfolding cf_hom_components 
    by (elim cat_prod_2_is_arrE[rotated 2]) (auto intro: cat_cs_intros)
  from op_g have g: "g : d ↦ℭ c" unfolding cat_op_simps by simp
  then have [simp]: "ℭ⦇Domβ¦ˆβ¦‡g⦈ = d" "ℭ⦇Codβ¦ˆβ¦‡g⦈ = c" 
    and d: "d ∈∘ ℭ⦇Obj⦈" and c: "c ∈∘ ℭ⦇Obj⦈"
    by auto
  from f have [simp]: "ℭ⦇Domβ¦ˆβ¦‡f⦈ = c'" "ℭ⦇Codβ¦ˆβ¦‡f⦈ = d'" 
    and c': "c' ∈∘ ℭ⦇Obj⦈" and d': "d' ∈∘ ℭ⦇Obj⦈"
    by auto
  show "vfsequence (cf_hom β„­ gf)" unfolding cf_hom_def by simp
  show vsv_hom_fg: "vsv (cf_hom β„­ gf⦇ArrVal⦈)"
    unfolding cf_hom_components by auto
  show "vcard (cf_hom β„­ gf) = 3β„•"
    unfolding cf_hom_def by (simp add: nat_omega_simps)
  show [simp]: "π’Ÿβˆ˜ (cf_hom β„­ gf⦇ArrVal⦈) = cf_hom β„­ gf⦇ArrDom⦈"
    unfolding cf_hom_components by auto
  show "β„›βˆ˜ (cf_hom β„­ gf⦇ArrVal⦈) βŠ†βˆ˜ cf_hom β„­ gf⦇ArrCod⦈"
  proof(rule vsubsetI)
    interpret hom_fg: vsv β€Ήcf_hom β„­ gf⦇ArrValβ¦ˆβ€Ί by (simp add: vsv_hom_fg)
    fix y assume "y ∈∘ β„›βˆ˜ (cf_hom β„­ gf⦇ArrVal⦈)"
    then obtain q where y_def: "y = cf_hom β„­ gf⦇ArrValβ¦ˆβ¦‡q⦈" 
      and q: "q ∈∘ π’Ÿβˆ˜ (cf_hom β„­ gf⦇ArrVal⦈)"
      by (blast dest: hom_fg.vrange_atD)
    from q have q: "q : c ↦ℭ c'" 
      by (simp add: cf_hom_ArrDom[OF assms[unfolded cc'_def]])
    with g f have "f ∘Aβ„­ q ∘Aβ„­ g : d ↦ℭ d'" 
      by (auto intro: cat_cs_intros)
    then show "y ∈∘ cf_hom β„­ gf⦇ArrCod⦈"  
      unfolding cf_hom_ArrCod[OF assms[unfolded dd'_def]]
      unfolding y_def gf_def cf_hom_ArrVal_app[OF op_g q f] 
      by auto
  qed
  from c c' show "cf_hom β„­ gf⦇ArrDom⦈ ∈∘ Vset Ξ±"
    unfolding cf_hom_components gf_def
    by (auto simp: nat_omega_simps intro: cat_cs_intros)
  from d d' show "cf_hom β„­ gf⦇ArrCod⦈ ∈∘ Vset Ξ±"
    unfolding cf_hom_components gf_def
    by (auto simp: nat_omega_simps intro: cat_cs_intros)
qed auto

lemmas [cat_cs_intros] = category.cat_cf_hom_ArrRel

lemma (in category) cat_cf_hom_cat_Set_is_arr:
  assumes "gf : [a, b]∘ ↦op_cat β„­ Γ—C β„­ [c, d]∘"
  shows "cf_hom β„­ gf : Hom β„­ a b ↦cat_Set Ξ± Hom β„­ c d"
proof(intro is_arrI)
  from assms cat_cf_hom_ArrRel show "cf_hom β„­ gf ∈∘ cat_Set α⦇Arr⦈"
    unfolding cat_Set_components by auto
  with assms show 
    "cat_Set α⦇Domβ¦ˆβ¦‡cf_hom β„­ gf⦈ = Hom β„­ a b"
    "cat_Set α⦇Codβ¦ˆβ¦‡cf_hom β„­ gf⦈ = Hom β„­ c d"
    unfolding cat_Set_components
    by (simp_all add: cf_hom_ArrDom[OF assms] cf_hom_ArrCod[OF assms])
qed

lemma (in category) cat_cf_hom_cat_Set_is_arr':
  assumes "gf : [a, b]∘ ↦op_cat β„­ Γ—C β„­ [c, d]∘"
    and "𝔄' = Hom β„­ a b"
    and "𝔅' = Hom β„­ c d"
    and "β„­' = cat_Set Ξ±"
  shows "cf_hom β„­ gf : 𝔄' ↦ℭ' 𝔅'"
  using assms(1) unfolding assms(2-4) by (rule cat_cf_hom_cat_Set_is_arr)

lemmas [cat_cs_intros] = category.cat_cf_hom_cat_Set_is_arr'


subsubsectionβ€ΉCompositionβ€Ί

lemma (in category) cat_cf_hom_Comp: 
  assumes "g : b ↦op_cat β„­ c" 
    and "g' : b' ↦ℭ c'" 
    and "f : a ↦op_cat β„­ b"
    and "f' : a' ↦ℭ b'"
  shows 
    "cf_hom β„­ [g, g']∘ ∘Acat_Set Ξ± cf_hom β„­ [f, f']∘ =
      cf_hom β„­ [g ∘Aop_cat β„­ f, g' ∘Aβ„­ f']∘"
proof-

  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)

  from assms(1,3) have g: "g : c ↦ℭ b" and f: "f : b ↦ℭ a"
    unfolding cat_op_simps by simp_all

  from assms(2,4) g f Set.category_axioms category_axioms have gg'_ff': 
    "cf_hom β„­ [g, g']∘ ∘Acat_Set Ξ± cf_hom β„­ [f, f']∘ :
      Hom β„­ a a' ↦cat_Set Ξ± Hom β„­ c c'"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
  then have dom_lhs: 
    "π’Ÿβˆ˜ ((cf_hom β„­ [g, g']∘ ∘Acat_Set Ξ± cf_hom β„­ [f, f']∘)⦇ArrVal⦈) = 
      Hom β„­ a a'"
    by (cs_concl cs_simp: cat_cs_simps)+
  from assms(2,4) g f Set.category_axioms category_axioms have gf_g'f':
    "cf_hom β„­ [g ∘Aop_cat β„­ f, g' ∘Aβ„­ f']∘ : 
      Hom β„­ a a' ↦cat_Set Ξ± Hom β„­ c c'"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
  then have dom_rhs: 
    "π’Ÿβˆ˜ (cf_hom β„­ [g ∘Aop_cat β„­ f, g' ∘Aβ„­ f']βˆ˜β¦‡ArrVal⦈) = Hom β„­ a a'" 
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    
    from gg'_ff' show arr_Set_gg'_ff':
      "arr_Set Ξ± (cf_hom β„­ [g, g']∘ ∘Acat_Set Ξ± cf_hom β„­ [f, f']∘)"
      by (auto dest: cat_Set_is_arrD(1))
    from gf_g'f' show arr_Set_gf_g'f':
      "arr_Set Ξ± (cf_hom β„­ [g ∘Aop_cat β„­ f, g' ∘Aβ„­ f']∘)"
      by (auto dest: cat_Set_is_arrD(1))
  
    show "(cf_hom β„­ [g, g']∘ ∘Acat_Set Ξ± cf_hom β„­ [f, f']∘)⦇ArrVal⦈ = 
      cf_hom β„­ [g ∘Aop_cat β„­ f, g' ∘Aβ„­ f']βˆ˜β¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix q assume "q ∈∘ Hom β„­ a a'"
      then have q: "q : a ↦ℭ a'" by auto
      from category_axioms g f assms(2,4) q Set.category_axioms show 
        "(cf_hom β„­ [g, g']∘ ∘Acat_Set Ξ± cf_hom β„­ [f, f']∘)⦇ArrValβ¦ˆβ¦‡q⦈ = 
          cf_hom β„­ [g ∘Aop_cat β„­ f, g' ∘Aβ„­ f']βˆ˜β¦‡ArrValβ¦ˆβ¦‡q⦈"
        by 
          (
            cs_concl 
              cs_intro: cat_op_intros cat_cs_intros cat_prod_cs_intros 
              cs_simp: cat_op_simps cat_cs_simps   
         )
    qed (use arr_Set_gg'_ff' arr_Set_gf_g'f' in auto)
  
  qed (use gg'_ff' gf_g'f' in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemmas [cat_cs_simps] = category.cat_cf_hom_Comp


subsubsectionβ€ΉIdentityβ€Ί

lemma (in category) cat_cf_hom_CId:
  assumes "[c, c']∘ ∈∘ (op_cat β„­ Γ—C β„­)⦇Obj⦈"
  shows "cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡c⦈, ℭ⦇CIdβ¦ˆβ¦‡c'⦈]∘ = cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c c'⦈"
proof-

  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)
  interpret op_β„­: category Ξ± β€Ήop_cat β„­β€Ί by (rule category_op)

  from assms have op_c: "c ∈∘ op_cat ℭ⦇Obj⦈" and c': "c' ∈∘ ℭ⦇Obj⦈"
    by (auto elim: cat_prod_2_ObjE[rotated 2] intro: cat_cs_intros)
  then have c: "c ∈∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp

  from c c' category_axioms Set.category_axioms have cf_hom_cc': 
    "cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡c⦈, ℭ⦇CIdβ¦ˆβ¦‡c'⦈]∘ : Hom β„­ c c' ↦cat_Set Ξ± Hom β„­ c c'"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_lhs: "π’Ÿβˆ˜ (cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡c⦈, ℭ⦇CIdβ¦ˆβ¦‡c'⦈]βˆ˜β¦‡ArrVal⦈) = Hom β„­ c c'"
    by (cs_concl cs_simp: cat_cs_simps)
  from c c' category_axioms Set.category_axioms have CId_cc':
    "cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c c'⦈ : Hom β„­ c c' ↦cat_Set Ξ± Hom β„­ c c'"
    by 
      (
        cs_concl 
          cs_simp: cat_Set_cs_simps cat_Set_components(1) 
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
  then have dom_rhs: "π’Ÿβˆ˜ (cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c c'β¦ˆβ¦‡ArrVal⦈) = Hom β„­ c c'"    
    by (cs_concl cs_simp: cat_cs_simps )

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from cf_hom_cc' show arr_Set_CId_cc': 
      "arr_Set Ξ± (cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡c⦈, ℭ⦇CIdβ¦ˆβ¦‡c'⦈]∘)"
      by (auto dest: cat_Set_is_arrD(1))  
    from CId_cc' show arr_Set_Hom_cc': 
      "arr_Set Ξ± (cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c c'⦈)"
      by (auto simp: cat_Set_is_arrD(1))
    show "cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡c⦈, ℭ⦇CIdβ¦ˆβ¦‡c'⦈]βˆ˜β¦‡ArrVal⦈ =
      cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c c'β¦ˆβ¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix q assume "q : c ↦ℭ c'" 
      with category_axioms show
        "cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡c⦈, ℭ⦇CIdβ¦ˆβ¦‡c'⦈]βˆ˜β¦‡ArrValβ¦ˆβ¦‡q⦈ = 
          cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c c'β¦ˆβ¦‡ArrValβ¦ˆβ¦‡q⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps cat_Set_cs_simps
              cs_intro: cat_cs_intros
         )
    qed (use arr_Set_CId_cc' arr_Set_Hom_cc' in auto)
  
  qed (use cf_hom_cc' CId_cc' in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemmas [cat_cs_simps] = category.cat_cf_hom_CId


subsubsectionβ€ΉOpposite β€Ήhomβ€Ί-functionβ€Ί

lemma (in category) cat_op_cat_cf_hom:
  assumes "g : a ↦ℭ b" and "g' : a' ↦op_cat β„­ b'"
  shows "cf_hom (op_cat β„­) [g, g']∘ = cf_hom β„­ [g', g]∘"
proof(rule arr_Set_eqI[of Ξ±])
  from assms show "arr_Set Ξ± (cf_hom (op_cat β„­) [g, g']∘)"
    by 
      ( 
        cs_concl 
          cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros
      )
  from assms show "arr_Set Ξ± (cf_hom β„­ [g', g]∘)"
    by 
      ( 
        cs_concl 
          cs_simp: cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  from assms have dom_lhs:
    "π’Ÿβˆ˜ (cf_hom (op_cat β„­) [g, g']βˆ˜β¦‡ArrVal⦈) = Hom β„­ a' a"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  from assms have dom_rhs: "π’Ÿβˆ˜ (cf_hom β„­ [g', g]βˆ˜β¦‡ArrVal⦈) = Hom β„­ a' a"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  show "cf_hom (op_cat β„­) [g, g']βˆ˜β¦‡ArrVal⦈ = cf_hom β„­ [g', g]βˆ˜β¦‡ArrVal⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
    fix f assume "f : a' ↦ℭ a"
    with assms show 
      "cf_hom (op_cat β„­) [g, g']βˆ˜β¦‡ArrValβ¦ˆβ¦‡f⦈ = cf_hom β„­ [g', g]βˆ˜β¦‡ArrValβ¦ˆβ¦‡f⦈"
      unfolding cat_op_simps
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  qed (simp_all add: cf_hom_components)
  from category_axioms assms show 
    "cf_hom (op_cat β„­) [g, g']βˆ˜β¦‡ArrDom⦈ = cf_hom β„­ [g', g]βˆ˜β¦‡ArrDom⦈"
    by 
      (
        cs_concl 
          cs_simp: category.cf_hom_ArrDom cat_op_simps 
          cs_intro: cat_op_intros cat_prod_cs_intros
      )
  from category_axioms assms show 
    "cf_hom (op_cat β„­) [g, g']βˆ˜β¦‡ArrCod⦈ = cf_hom β„­ [g', g]βˆ˜β¦‡ArrCod⦈"
    by 
      (
        cs_concl 
          cs_simp: category.cf_hom_ArrCod cat_op_simps 
          cs_intro: cat_op_intros cat_prod_cs_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_op_cat_cf_hom



subsectionβ€Ήβ€ΉHomβ€Ί-functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
See \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/hom-functor
}}.
β€Ί

definition cf_Hom :: "V β‡’ V β‡’ V" (β€ΉHomO.CΔ±_'(/-,-/')β€Ί)
  where "HomO.CΞ±β„­(-,-) = 
    [
      (Ξ»a∈∘(op_cat β„­ Γ—C β„­)⦇Obj⦈. Hom β„­ (vpfst a) (vpsnd a)),
      (Ξ»f∈∘(op_cat β„­ Γ—C β„­)⦇Arr⦈. cf_hom β„­ f),
      op_cat β„­ Γ—C β„­,
      cat_Set Ξ±
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_Hom_components:
  shows "HomO.CΞ±β„­(-,-)⦇ObjMap⦈ = 
    (Ξ»a∈∘(op_cat β„­ Γ—C β„­)⦇Obj⦈. Hom β„­ (vpfst a) (vpsnd a))"
    and "HomO.CΞ±β„­(-,-)⦇ArrMap⦈ = (Ξ»f∈∘(op_cat β„­ Γ—C β„­)⦇Arr⦈. cf_hom β„­ f)"
    and "HomO.CΞ±β„­(-,-)⦇HomDom⦈ = op_cat β„­ Γ—C β„­"
    and "HomO.CΞ±β„­(-,-)⦇HomCod⦈ = cat_Set Ξ±"
  unfolding cf_Hom_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda cf_Hom_components(1)
  |vsv cf_Hom_ObjMap_vsv|

lemma cf_Hom_ObjMap_vdomain[cat_cs_simps]:  
  "π’Ÿβˆ˜ (HomO.CΞ±β„­(-,-)⦇ObjMap⦈) = (op_cat β„­ Γ—C β„­)⦇Obj⦈"
  unfolding cf_Hom_components by simp

lemma cf_Hom_ObjMap_app[cat_cs_simps]: 
  assumes "[a, b]∘ ∈∘ (op_cat β„­ Γ—C β„­)⦇Obj⦈"
  shows "HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = Hom β„­ a b"
  using assms unfolding cf_Hom_components by (simp add: nat_omega_simps)
                
lemma (in category) cf_Hom_ObjMap_vrange: 
  "β„›βˆ˜ (HomO.CΞ±β„­(-,-)⦇ObjMap⦈) βŠ†βˆ˜ cat_Set α⦇Obj⦈"
proof(intro vsubsetI)
  interpret op_β„­: category Ξ± β€Ήop_cat β„­β€Ί by (simp add: category_op)
  fix y assume "y ∈∘ β„›βˆ˜ (HomO.CΞ±β„­(-,-)⦇ObjMap⦈)"
  then obtain x where y_def: "y = HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡x⦈" 
    and x: "x ∈∘ (op_cat β„­ Γ—C β„­)⦇Obj⦈"
    unfolding cf_Hom_components by auto
  then obtain a b where x_def: "x = [a, b]∘" 
    and a: "a ∈∘ op_cat ℭ⦇Obj⦈" 
    and b: "b ∈∘ ℭ⦇Obj⦈" 
    by (elim cat_prod_2_ObjE[OF op_β„­.category_axioms category_axioms x])
  from a have a: "a ∈∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
  from a b show "y ∈∘ cat_Set α⦇Obj⦈"
    unfolding 
      y_def x_def cf_Hom_ObjMap_app[OF x[unfolded x_def]] cat_Set_components
    by (auto simp: cat_cs_intros)
qed


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda cf_Hom_components(2)
  |vsv cf_Hom_ArrMap_vsv|
  |vdomain cf_Hom_ArrMap_vdomain[cat_cs_simps]|
  |app cf_Hom_ArrMap_app[cat_cs_simps]|


subsubsectionβ€Ήβ€ΉHomβ€Ί-functor is a functorβ€Ί

lemma (in category) cat_Hom_is_functor:
  "HomO.CΞ±β„­(-,-) : op_cat β„­ Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
proof-

  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)
  interpret β„­β„­: category Ξ± β€Ήop_cat β„­ Γ—C β„­β€Ί
    by (simp add: category_axioms category_cat_prod_2 category_op)
  interpret op_β„­: category Ξ± β€Ήop_cat β„­β€Ί by (rule category_op)

  show ?thesis
  proof(intro is_functorI')

    show "vfsequence HomO.CΞ±β„­(-,-)"
      unfolding cf_Hom_def by simp
    show op_β„­_β„­: "category Ξ± (op_cat β„­ Γ—C β„­)" by (auto simp: cat_cs_intros)
    show "vcard HomO.CΞ±β„­(-,-) = 4β„•"
      unfolding cf_Hom_def by (simp add: nat_omega_simps)
  
    show "β„›βˆ˜ (HomO.CΞ±β„­(-,-)⦇ObjMap⦈) βŠ†βˆ˜ cat_Set α⦇Obj⦈"
      by (simp add: cf_Hom_ObjMap_vrange)
    show "HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡gf⦈ :
      HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡ab⦈ ↦cat_Set Ξ± HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡cd⦈"
      if gf: "gf : ab ↦op_cat β„­ Γ—C β„­ cd" for gf ab cd
      unfolding slicing_simps cat_smc_cat_Set[symmetric]
    proof-
      obtain g f a b c d where gf_def: "gf = [g, f]∘"
        and ab_def: "ab = [a, b]∘"
        and cd_def: "cd = [c, d]∘"   
        and "g : a ↦op_cat β„­ c"  
        and f: "f : b ↦ℭ d"
        by (elim cat_prod_2_is_arrE[OF category_op category_axioms gf])
      then have g: "g : c ↦ℭ a" unfolding cat_op_simps by simp
      from category_axioms that g f show "HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡gf⦈ :
        HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡ab⦈ ↦cat_Set Ξ± HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡cd⦈"
        unfolding gf_def ab_def cd_def (*slow*)
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
    qed

    show "HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡gg' ∘Aop_cat β„­ Γ—C β„­ ff'⦈ = 
      HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡gg'⦈ ∘Acat_Set Ξ± HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡ff'⦈"
      if gg': "gg' : bb' ↦op_cat β„­ Γ—C β„­ cc'" 
        and ff': "ff' : aa' ↦op_cat β„­ Γ—C β„­ bb'" 
      for gg' bb' cc' ff' aa'
    proof-
      obtain g g' b b' c c' 
        where gg'_def: "gg' = [g, g']∘"
          and bb'_def: "bb' = [b, b']∘"
          and cc'_def: "cc' = [c, c']∘"   
          and "g : b ↦op_cat β„­ c"  
          and g': "g' : b' ↦ℭ c'"
        by (elim cat_prod_2_is_arrE[OF category_op category_axioms gg'])
      moreover obtain f f' a a' b'' b''' 
        where ff'_def: "ff' = [f, f']∘"
          and aa'_def: "aa' = [a, a']∘"
          and "bb' = [b'', b''']∘"   
          and "f : a ↦op_cat β„­ b''"  
          and "f' : a' ↦ℭ b'''"
        by (elim cat_prod_2_is_arrE[OF category_op category_axioms ff'])
      ultimately have f: "f : b ↦ℭ a" 
        and f': "f' : a' ↦ℭ b'" 
        and g: "g : c ↦ℭ b"
        by (auto simp: cat_op_simps)
      from category_axioms that g f  g' f' show ?thesis
        unfolding 
          slicing_simps cat_smc_cat_Set[symmetric] 
          gg'_def bb'_def cc'_def ff'_def aa'_def
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps cat_prod_cs_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed

    show "HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡(op_cat β„­ Γ—C β„­)⦇CIdβ¦ˆβ¦‡cc'⦈⦈ = 
      cat_Set α⦇CIdβ¦ˆβ¦‡HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡cc'⦈⦈"
      if "cc' ∈∘ (op_cat β„­ Γ—C β„­)⦇Obj⦈" for cc'
    proof-
      from that obtain c c' 
        where cc'_def: "cc' = [c, c']∘" 
          and c: "c ∈∘ op_cat ℭ⦇Obj⦈"
          and c': "c' ∈∘ ℭ⦇Obj⦈"
        by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
      then have c: "c ∈∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
      with c' category_axioms Set.category_axioms that show ?thesis
        unfolding cc'_def
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_op_simps cat_prod_cs_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed

  qed (auto simp: cf_Hom_components cat_cs_intros)

qed

lemma (in category) cat_Hom_is_functor':
  assumes "Ξ² = Ξ±" and "𝔄' = op_cat β„­ Γ—C β„­" and "𝔅' = cat_Set Ξ±"
  shows "HomO.CΞ±β„­(-,-) : 𝔄' ↦↦CΞ² 𝔅'"
  unfolding assms by (rule cat_Hom_is_functor)

lemmas [cat_cs_intros] = category.cat_Hom_is_functor'



subsectionβ€ΉComposition of a β€ΉHomβ€Ί-functor and two functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_bcomp_Hom :: "V β‡’ V β‡’ V β‡’ V β‡’ V" (β€ΉHomO.CΔ±_'(/_-,_-/')β€Ί)
  ―‹The following definition may seem redundant, but it will help to avoid
  proof duplication later.β€Ί
  where "HomO.CΞ±β„­(𝔉-,π”Š-) = cf_cn_cov_bcomp (HomO.CΞ±β„­(-,-)) 𝔉 π”Š"


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_bcomp_Hom_ObjMap_vsv: "vsv (HomO.CΞ±β„­(𝔉-,π”Š-)⦇ObjMap⦈)"
  unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)

lemma cf_bcomp_Hom_ObjMap_vdomain[cat_cs_simps]:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(𝔉-,π”Š-)⦇ObjMap⦈) = (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
  using assms unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ObjMap_vdomain)

lemma cf_bcomp_Hom_ObjMap_app[cat_cs_simps]:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "[a, b]∘ ∈∘ (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
  shows "HomO.CΞ±β„­(𝔉-,π”Š-)⦇ObjMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = 
    HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡a⦈, π”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
  using assms unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ObjMap_app)
  
lemma (in category) cf_bcomp_Hom_ObjMap_vrange:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomO.CΞ±β„­(𝔉-,π”Š-)⦇ObjMap⦈) βŠ†βˆ˜ cat_Set α⦇Obj⦈"
  using category_axioms
  unfolding cf_bcomp_Hom_def
  by (intro cf_cn_cov_bcomp_ObjMap_vrange[OF assms])
    (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_bcomp_Hom_ArrMap_vsv: "vsv (HomO.CΞ±β„­(𝔉-,π”Š-)⦇ArrMap⦈)"
  unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)

lemma cf_bcomp_Hom_ArrMap_vdomain[cat_cs_simps]:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(𝔉-,π”Š-)⦇ArrMap⦈) = (op_cat 𝔄 Γ—C 𝔅)⦇Arr⦈"
  using assms 
  unfolding cf_bcomp_Hom_def 
  by (rule cf_cn_cov_bcomp_ArrMap_vdomain)

lemma cf_bcomp_Hom_ArrMap_app[cat_cs_simps]:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "[f, g]∘ ∈∘ (op_cat 𝔄 Γ—C 𝔅)⦇Arr⦈"
  shows 
    "HomO.CΞ±β„­(𝔉-,π”Š-)⦇ArrMapβ¦ˆβ¦‡f, gβ¦ˆβˆ™ = 
      HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡f⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡gβ¦ˆβ¦ˆβˆ™"
  using assms 
  unfolding cf_bcomp_Hom_def 
  by (rule cf_cn_cov_bcomp_ArrMap_app)

lemma (in category) cf_bcomp_Hom_ArrMap_vrange:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomO.CΞ±β„­(𝔉-,π”Š-)⦇ArrMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
  using category_axioms
  unfolding cf_bcomp_Hom_def
  by (intro cf_cn_cov_bcomp_ArrMap_vrange[OF assms])
    (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)


subsubsectionβ€ΉComposition of a β€ΉHomβ€Ί-functor and two functors is a functorβ€Ί

lemma (in category) cat_cf_bcomp_Hom_is_functor:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "HomO.CΞ±β„­(𝔉-,π”Š-) : op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
  using assms category_axioms
  unfolding cf_bcomp_Hom_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma (in category) cat_cf_bcomp_Hom_is_functor':
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­" 
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "Ξ² = Ξ±"
    and "𝔄' = op_cat 𝔄 Γ—C 𝔅"
    and "𝔅' = cat_Set Ξ±"
  shows "HomO.CΞ±β„­(𝔉-,π”Š-) : 𝔄' ↦↦CΞ² 𝔅'"
  using assms(1,2) unfolding assms(3-5) by (rule cat_cf_bcomp_Hom_is_functor)

lemmas [cat_cs_intros] = category.cat_cf_bcomp_Hom_is_functor'



subsectionβ€ΉComposition of a β€ΉHomβ€Ί-functor and a functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee subsection 1.15 in \cite{bodo_categories_1970}.β€Ί

definition cf_lcomp_Hom :: "V β‡’ V β‡’ V β‡’ V" (β€ΉHomO.CΔ±_'(/_-,-/')β€Ί)
  where "HomO.CΞ±β„­(𝔉-,-) = cf_cn_cov_lcomp β„­ (HomO.CΞ±β„­(-,-)) 𝔉"

definition cf_rcomp_Hom :: "V β‡’ V β‡’ V β‡’ V" (β€ΉHomO.CΔ±_'(/-,_-/')β€Ί)
  where "HomO.CΞ±β„­(-,π”Š-) = cf_cn_cov_rcomp β„­ (HomO.CΞ±β„­(-,-)) π”Š"


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_lcomp_Hom_ObjMap_vsv[cat_cs_intros]: "vsv (HomO.CΞ±β„­(𝔉-,-)⦇ObjMap⦈)"
  unfolding cf_lcomp_Hom_def by (rule cf_cn_cov_lcomp_ObjMap_vsv)

lemma cf_rcomp_Hom_ObjMap_vsv[cat_cs_intros]: "vsv (HomO.CΞ±β„­(-,π”Š-)⦇ObjMap⦈)"
  unfolding cf_rcomp_Hom_def by (rule cf_cn_cov_rcomp_ObjMap_vsv)

lemma cf_lcomp_Hom_ObjMap_vdomain[cat_cs_simps]:
  assumes "category Ξ± β„­" and "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(𝔉-,-)⦇ObjMap⦈) = (op_cat 𝔅 Γ—C β„­)⦇Obj⦈"
  using assms
  by (cs_concl cs_simp: cat_cs_simps cf_lcomp_Hom_def cs_intro: cat_cs_intros)

lemma cf_rcomp_Hom_ObjMap_vdomain[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(-,π”Š-)⦇ObjMap⦈) = (op_cat β„­ Γ—C 𝔅)⦇Obj⦈"
  using assms
  by (cs_concl cs_simp: cat_cs_simps cf_rcomp_Hom_def cs_intro: cat_cs_intros)

lemma cf_lcomp_Hom_ObjMap_app[cat_cs_simps]:
  assumes "category Ξ± β„­"
    and "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "b ∈∘ op_cat 𝔅⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "HomO.CΞ±β„­(𝔉-,-)⦇ObjMapβ¦ˆβ¦‡b, cβ¦ˆβˆ™ = 
    HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡b⦈, cβ¦ˆβˆ™"
  using assms
  unfolding cf_lcomp_Hom_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)

lemma cf_rcomp_Hom_ObjMap_app[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "c ∈∘ op_cat ℭ⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomO.CΞ±β„­(-,π”Š-)⦇ObjMapβ¦ˆβ¦‡c, bβ¦ˆβˆ™ =
    HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡c, π”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ¦ˆβˆ™"
  using assms
  by 
    (
      cs_concl
        cs_simp: cat_cs_simps cf_rcomp_Hom_def
        cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
    )

lemma (in category) cat_cf_lcomp_Hom_ObjMap_vrange: 
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomO.CΞ±β„­(𝔉-,-)⦇ObjMap⦈) βŠ†βˆ˜ cat_Set α⦇Obj⦈"
  using category_axioms assms
  unfolding cf_lcomp_Hom_def
  by (intro cf_cn_cov_lcomp_ObjMap_vrange) 
    (cs_concl cs_intro: cat_cs_intros)

lemma (in category) cat_cf_rcomp_Hom_ObjMap_vrange: 
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomO.CΞ±β„­(-,π”Š-)⦇ObjMap⦈) βŠ†βˆ˜ cat_Set α⦇Obj⦈"
  using category_axioms assms
  unfolding cf_rcomp_Hom_def  
  by (intro cf_cn_cov_rcomp_ObjMap_vrange) 
    (cs_concl cs_intro: cat_cs_intros)


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_lcomp_Hom_ArrMap_vsv[cat_cs_intros]: "vsv (HomO.CΞ±β„­(𝔉-,-)⦇ArrMap⦈)"
  unfolding cf_lcomp_Hom_def by (rule cf_cn_cov_lcomp_ArrMap_vsv)

lemma cf_rcomp_Hom_ArrMap_vsv[cat_cs_intros]: "vsv (HomO.CΞ±β„­(-,π”Š-)⦇ArrMap⦈)"
  unfolding cf_rcomp_Hom_def by (rule cf_cn_cov_rcomp_ArrMap_vsv)

lemma cf_lcomp_Hom_ArrMap_vdomain[cat_cs_simps]:  
  assumes "category Ξ± β„­" and "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(𝔉-,-)⦇ArrMap⦈) = (op_cat 𝔅 Γ—C β„­)⦇Arr⦈"
  using assms
  unfolding cf_lcomp_Hom_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma cf_rcomp_Hom_ArrMap_vdomain[cat_cs_simps]:  
  assumes "category Ξ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(-,π”Š-)⦇ArrMap⦈) = (op_cat β„­ Γ—C 𝔅)⦇Arr⦈"
  using assms unfolding cf_rcomp_Hom_def by (cs_concl cs_simp: cat_cs_simps)

lemma cf_lcomp_Hom_ArrMap_app[cat_cs_simps]:
  assumes "category Ξ± β„­" 
    and "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "g : a ↦op_cat 𝔅 b"
    and "f : a' ↦ℭ b'"
  shows "HomO.CΞ±β„­(𝔉-,-)⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ =
    HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡g⦈, fβ¦ˆβˆ™"
  using assms
  unfolding cf_lcomp_Hom_def cat_op_simps 
  by 
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_op_simps 
        cs_intro: cat_cs_intros cat_prod_cs_intros
    )

lemma cf_rcomp_Hom_ArrMap_app[cat_cs_simps]:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "g : a ↦op_cat β„­ b"
    and "f : a' ↦𝔅 b'"
  shows "HomO.CΞ±β„­(-,π”Š-)⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ =
    HomO.CΞ±β„­(-,-)⦇ArrMapβ¦ˆβ¦‡g, π”Šβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦ˆβˆ™"
  using assms 
  by
    (
      cs_concl
        cs_simp: cat_cs_simps cf_rcomp_Hom_def
        cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
    )

lemma (in category) cf_lcomp_Hom_ArrMap_vrange: 
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomO.CΞ±β„­(𝔉-,-)⦇ArrMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
  using category_axioms assms
  unfolding cf_lcomp_Hom_def
  by (intro cf_cn_cov_lcomp_ArrMap_vrange)
    (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma (in category) cf_rcomp_Hom_ArrMap_vrange: 
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomO.CΞ±β„­(-,π”Š-)⦇ArrMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
  using category_axioms assms
  unfolding cf_rcomp_Hom_def
  by (intro cf_cn_cov_rcomp_ArrMap_vrange)
    (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma cf_bcomp_Hom_cf_lcomp_Hom[cat_cs_simps]:
  "HomO.CΞ±β„­(𝔉-,cf_id β„­-) = HomO.CΞ±β„­(𝔉-,-)"
  unfolding cf_lcomp_Hom_def cf_cn_cov_lcomp_def cf_bcomp_Hom_def ..

lemma cf_bcomp_Hom_cf_rcomp_Hom[cat_cs_simps]:
  "HomO.CΞ±β„­(cf_id β„­-,π”Š-) = HomO.CΞ±β„­(-,π”Š-)"
  unfolding cf_rcomp_Hom_def cf_cn_cov_rcomp_def cf_bcomp_Hom_def ..


subsubsectionβ€ΉComposition of a β€ΉHomβ€Ί-functor and a functor is a functorβ€Ί

lemma (in category) cat_cf_lcomp_Hom_is_functor:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "HomO.CΞ±β„­(𝔉-,-) : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
  using category_axioms assms
  unfolding cf_lcomp_Hom_def
  by (intro cf_cn_cov_lcomp_is_functor) 
    (cs_concl cs_intro: cat_cs_intros)

lemma (in category) cat_cf_lcomp_Hom_is_functor':
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" 
    and "Ξ² = Ξ±" 
    and "𝔄' = op_cat 𝔅 Γ—C β„­" 
    and "𝔅' = cat_Set Ξ±"
  shows "HomO.CΞ±β„­(𝔉-,-) : 𝔄' ↦↦CΞ² 𝔅'"
  using assms(1) 
  unfolding assms(2-4) 
  by (rule cat_cf_lcomp_Hom_is_functor) 

lemmas [cat_cs_intros] = category.cat_cf_lcomp_Hom_is_functor'

lemma (in category) cat_cf_rcomp_Hom_is_functor:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "HomO.CΞ±β„­(-,π”Š-) : op_cat β„­ Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
  using category_axioms assms
  unfolding cf_rcomp_Hom_def
  by (intro cf_cn_cov_rcomp_is_functor) 
    (cs_concl cs_intro: cat_cs_intros cat_op_intros)

lemma (in category) cat_cf_rcomp_Hom_is_functor':
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "Ξ² = Ξ±" 
    and "𝔄' = op_cat β„­ Γ—C 𝔅" 
    and "𝔅' = cat_Set Ξ±"
  shows "HomO.CΞ±β„­(-,π”Š-) : 𝔄' ↦↦CΞ² 𝔅'"
  using assms(1) 
  unfolding assms(2-4) 
  by (rule cat_cf_rcomp_Hom_is_functor) 

lemmas [cat_cs_intros] = category.cat_cf_rcomp_Hom_is_functor'


subsubsectionβ€ΉFlip of a projections of a β€ΉHomβ€Ί-functorβ€Ί

lemma (in category) cat_bifunctor_flip_cf_rcomp_Hom:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows 
    "bifunctor_flip (op_cat β„­) 𝔅 (HomO.CΞ±β„­(-,π”Š-)) =
      HomO.CΞ±op_cat β„­(op_cf π”Š-,-)"
proof(rule cf_eqI)

  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms)

  from category_axioms assms show bf_Hom:
    "bifunctor_flip (op_cat β„­) 𝔅 HomO.CΞ±β„­(-,π”Š-) :
      𝔅 Γ—C op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_intro: cat_cs_intros)
  from category_axioms assms show op_Hom:
    "HomO.CΞ±op_cat β„­(op_cf π”Š-,-) : 𝔅 Γ—C op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

  from bf_Hom have ObjMap_dom_lhs:
    "π’Ÿβˆ˜ (bifunctor_flip (op_cat β„­) 𝔅 HomO.CΞ±β„­(-,π”Š-)⦇ObjMap⦈) = 
      (𝔅 Γ—C op_cat β„­)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from op_Hom have ObjMap_dom_rhs:
    "π’Ÿβˆ˜ (HomO.CΞ±op_cat β„­(op_cf π”Š-,-)⦇ObjMap⦈) = (𝔅 Γ—C op_cat β„­)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from bf_Hom have ArrMap_dom_lhs:
    "π’Ÿβˆ˜ (bifunctor_flip (op_cat β„­) 𝔅 HomO.CΞ±β„­(-,π”Š-)⦇ArrMap⦈) = 
      (𝔅 Γ—C op_cat β„­)⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  from op_Hom have ArrMap_dom_rhs:
    "π’Ÿβˆ˜ (HomO.CΞ±op_cat β„­(op_cf π”Š-,-)⦇ArrMap⦈) = (𝔅 Γ—C op_cat β„­)⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps)

  show 
    "bifunctor_flip (op_cat β„­) 𝔅 HomO.CΞ±β„­(-,π”Š-)⦇ObjMap⦈ =
      HomO.CΞ±op_cat β„­(op_cf π”Š-,-)⦇ObjMap⦈"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix bc assume "bc ∈∘ (𝔅 Γ—C op_cat β„­)⦇Obj⦈"
    then obtain b c 
      where bc_def: "bc = [b, c]∘" and b: "b ∈∘ 𝔅⦇Obj⦈" and c: "c ∈∘ ℭ⦇Obj⦈"
      by 
        (
          auto 
            elim: cat_prod_2_ObjE[OF π”Š.HomDom.category_axioms category_op] 
            simp: cat_op_simps
        )
    from category_axioms assms b c show 
      "bifunctor_flip (op_cat β„­) 𝔅 HomO.CΞ±β„­(-,π”Š-)⦇ObjMapβ¦ˆβ¦‡bc⦈ =
        HomO.CΞ±op_cat β„­(op_cf π”Š-,-)⦇ObjMapβ¦ˆβ¦‡bc⦈"
      unfolding bc_def
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (auto intro: cat_cs_intros)

  show 
    "bifunctor_flip (op_cat β„­) 𝔅 HomO.CΞ±β„­(-,π”Š-)⦇ArrMap⦈ =
      HomO.CΞ±op_cat β„­(op_cf π”Š-,-)⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix gf assume "gf ∈∘ (𝔅 Γ—C op_cat β„­)⦇Arr⦈"
    then obtain g f 
      where gf_def: "gf = [g, f]∘" and "g ∈∘ 𝔅⦇Arr⦈" and "f ∈∘ ℭ⦇Arr⦈"
      by 
        (
          auto 
            elim: cat_prod_2_ArrE[OF π”Š.HomDom.category_axioms category_op] 
            simp: cat_op_simps
        )
    then obtain a b c d where g: "g : a ↦𝔅 b" and f: "f : c ↦ℭ d"
      by (auto intro!: is_arrI)
    from category_axioms assms g f show 
      "bifunctor_flip (op_cat β„­) 𝔅 HomO.CΞ±β„­(-,π”Š-)⦇ArrMapβ¦ˆβ¦‡gf⦈ =
        HomO.CΞ±op_cat β„­(op_cf π”Š-,-)⦇ArrMapβ¦ˆβ¦‡gf⦈"
      unfolding gf_def
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (auto intro: cat_cs_intros)

qed (auto intro: cat_cs_intros simp: cat_op_simps)

lemmas [cat_cs_simps] = category.cat_bifunctor_flip_cf_rcomp_Hom 

lemma (in category) cat_bifunctor_flip_cf_lcomp_Hom:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows 
    "bifunctor_flip (op_cat 𝔅) β„­ (HomO.CΞ±β„­(𝔉-,-)) =
      HomO.CΞ±op_cat β„­(-,op_cf 𝔉-)"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  note Hom_𝔉 = 
    category.cat_bifunctor_flip_cf_rcomp_Hom
      [
        OF category_op is_functor_op[OF assms], 
        unfolded cat_op_simps, 
        symmetric
      ]
  from category_axioms assms show ?thesis
    by (subst Hom_𝔉)
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros
      )+
qed

lemmas [cat_cs_simps] = category.cat_bifunctor_flip_cf_lcomp_Hom



subsectionβ€ΉProjections of the β€ΉHomβ€Ί-functorβ€Ί


textβ€Ή
The projections of the β€ΉHomβ€Ί-functor coincide with the definitions
of the β€ΉHomβ€Ί-functor given in Chapter II-2 in \cite{mac_lane_categories_2010}.
They are also exposed in the aforementioned article in 
nLab \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/hom-functor
}}.
β€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί

definition cf_Hom_snd :: "V β‡’ V β‡’ V β‡’ V" (β€ΉHomO.CΔ±_'(/_,-/')β€Ί)
  where "HomO.CΞ±β„­(a,-) = HomO.CΞ±β„­(-,-)op_cat β„­,β„­(a,-)CF"
definition cf_Hom_fst :: "V β‡’ V β‡’ V β‡’ V" (β€ΉHomO.CΔ±_'(/-,_/')β€Ί)
  where "HomO.CΞ±β„­(-,b) = HomO.CΞ±β„­(-,-)op_cat β„­,β„­(-,b)CF"


subsubsectionβ€ΉProjections of the β€ΉHomβ€Ί-functor are functorsβ€Ί

lemma (in category) cat_cf_Hom_snd_is_functor:
  assumes "a ∈∘ ℭ⦇Obj⦈"
  shows "HomO.CΞ±β„­(a,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
proof-  
  from assms have a: "a ∈∘ op_cat ℭ⦇Obj⦈" unfolding cat_op_simps by simp
  have op_β„­: "category Ξ± (op_cat β„­)" by (auto intro: cat_cs_intros)
  from op_β„­ category_axioms cat_Hom_is_functor a show ?thesis
    unfolding cf_Hom_snd_def by (rule bifunctor_proj_snd_is_functor)
qed

lemma (in category) cat_cf_Hom_snd_is_functor':
  assumes "a ∈∘ ℭ⦇Obj⦈" and "Ξ² = Ξ±" and "β„­' = β„­" and "𝔇' = cat_Set Ξ±"
  shows "HomO.CΞ±β„­(a,-) : β„­' ↦↦CΞ² 𝔇'"
  using assms(1) unfolding assms(2-4) by (rule cat_cf_Hom_snd_is_functor)

lemmas [cat_cs_intros] = category.cat_cf_Hom_snd_is_functor'

lemma (in category) cat_cf_Hom_fst_is_functor:
  assumes "b ∈∘ ℭ⦇Obj⦈"
  shows "HomO.CΞ±β„­(-,b) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
proof-  
  have op_β„­: "category Ξ± (op_cat β„­)" by (auto intro: cat_cs_intros)
  from op_β„­ category_axioms cat_Hom_is_functor assms show ?thesis
    unfolding cf_Hom_fst_def by (rule bifunctor_proj_fst_is_functor)
qed

lemma (in category) cat_cf_Hom_fst_is_functor':
  assumes "b ∈∘ ℭ⦇Obj⦈" and "Ξ² = Ξ±" and "β„­' = op_cat β„­" and "𝔇' = cat_Set Ξ±"
  shows "HomO.CΞ±β„­(-,b) : β„­' ↦↦CΞ² 𝔇'"
  using assms(1) unfolding assms(2-4) by (rule cat_cf_Hom_fst_is_functor)

lemmas [cat_cs_intros] = category.cat_cf_Hom_fst_is_functor'


subsubsectionβ€ΉObject mapsβ€Ί

lemma (in category) cat_cf_Hom_snd_ObjMap_vsv[cat_cs_intros]:
  assumes "a ∈∘ ℭ⦇Obj⦈"
  shows "vsv (HomO.CΞ±β„­(a,-)⦇ObjMap⦈)"
  unfolding cf_Hom_snd_def
  using category_axioms assms
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

lemmas [cat_cs_intros] = category.cat_cf_Hom_snd_ObjMap_vsv

lemma (in category) cat_cf_Hom_fst_ObjMap_vsv[cat_cs_intros]:
  assumes "b ∈∘ ℭ⦇Obj⦈"
  shows "vsv (HomO.CΞ±β„­(-,b)⦇ObjMap⦈)"
  unfolding cf_Hom_fst_def
  using category_axioms assms
  by
    (
      cs_concl 
        cs_simp: cat_prod_cs_simps cat_cs_simps
        cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
    )

lemmas [cat_cs_intros] = category.cat_cf_Hom_fst_ObjMap_vsv

lemma (in category) cat_cf_Hom_snd_ObjMap_vdomain[cat_cs_simps]:
  assumes "a ∈∘ ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(a,-)⦇ObjMap⦈) = ℭ⦇Obj⦈"
  using category_axioms assms
  unfolding cf_Hom_snd_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ObjMap_vdomain

lemma (in category) cat_cf_Hom_fst_ObjMap_vdomain[cat_cs_simps]:
  assumes "b ∈∘ ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(-,b)⦇ObjMap⦈) = op_cat ℭ⦇Obj⦈"
  using category_axioms assms
  unfolding cf_Hom_fst_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ObjMap_vdomain

lemma (in category) cat_cf_Hom_snd_ObjMap_app[cat_cs_simps]:
  assumes "a ∈∘ op_cat ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "HomO.CΞ±β„­(a,-)⦇ObjMapβ¦ˆβ¦‡b⦈ = Hom β„­ a b"
proof-
  from assms have ab: "[a, b]∘ ∈∘ (op_cat β„­ Γ—C β„­)⦇Obj⦈"
    by (intro cat_prod_2_ObjI) (auto intro: cat_cs_intros)
  show ?thesis
    unfolding 
      cf_Hom_snd_def
      bifunctor_proj_snd_ObjMap_app[OF category_op category_axioms ab]
      cf_Hom_ObjMap_app[OF ab]
      ..
qed

lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ObjMap_app

lemma (in category) cat_cf_Hom_fst_ObjMap_app[cat_cs_simps]:
  assumes "b ∈∘ ℭ⦇Obj⦈" and "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "HomO.CΞ±β„­(-,b)⦇ObjMapβ¦ˆβ¦‡a⦈ = Hom β„­ a b"
proof-
  from assms have ab: "[a, b]∘ ∈∘ (op_cat β„­ Γ—C β„­)⦇Obj⦈"
    by (intro cat_prod_2_ObjI) (auto intro: cat_cs_intros)
  show ?thesis
    unfolding 
      cf_Hom_fst_def
      bifunctor_proj_fst_ObjMap_app[OF category_op category_axioms ab]
      cf_Hom_ObjMap_app[OF ab]
      ..
qed

lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ObjMap_app


subsubsectionβ€ΉArrow mapsβ€Ί

lemma (in category) cat_cf_Hom_snd_ArrMap_vsv[cat_cs_intros]:
  assumes "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "vsv (HomO.CΞ±β„­(a,-)⦇ArrMap⦈)"
  unfolding cf_Hom_snd_def
  using category_axioms assms
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps 
        cs_intro: bifunctor_proj_snd_ArrMap_vsv cat_cs_intros cat_op_intros
    )

lemmas [cat_cs_intros] = category.cat_cf_Hom_snd_ArrMap_vsv

lemma (in category) cat_cf_Hom_fst_ArrMap_vsv[cat_cs_intros]:
  assumes "b ∈∘ ℭ⦇Obj⦈"
  shows "vsv (HomO.CΞ±β„­(-,b)⦇ArrMap⦈)"
  unfolding cf_Hom_fst_def
  using category_axioms assms
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps
        cs_intro: bifunctor_proj_fst_ArrMap_vsv cat_cs_intros cat_op_intros
    )

lemmas [cat_cs_intros] = category.cat_cf_Hom_fst_ArrMap_vsv

lemma (in category) cat_cf_Hom_snd_ArrMap_vdomain[cat_cs_simps]:
  assumes "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(a,-)⦇ArrMap⦈) = ℭ⦇Arr⦈"
  using category_axioms assms
  unfolding cf_Hom_snd_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ArrMap_vdomain

lemma (in category) cat_cf_Hom_fst_ArrMap_vdomain[cat_cs_simps]:
  assumes "b ∈∘ ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ (HomO.CΞ±β„­(-,b)⦇ArrMap⦈) = op_cat ℭ⦇Arr⦈"
  using category_axioms assms
  unfolding cf_Hom_fst_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ArrMap_vdomain

lemma (in category) cat_cf_Hom_snd_ArrMap_app[cat_cs_simps]:
  assumes "a ∈∘ op_cat ℭ⦇Obj⦈" and "f : b ↦ℭ b'"
  shows "HomO.CΞ±β„­(a,-)⦇ArrMapβ¦ˆβ¦‡f⦈ = cf_hom β„­ [op_cat ℭ⦇CIdβ¦ˆβ¦‡a⦈, f]∘"
proof-
  from assms(2) have f: "f ∈∘ ℭ⦇Arr⦈" by (simp add: cat_cs_intros)
  from category_axioms assms show ?thesis
    unfolding 
      cf_Hom_snd_def
      bifunctor_proj_snd_ArrMap_app[OF category_op category_axioms assms(1) f]
      cat_op_simps
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ArrMap_app

lemma (in category) cat_cf_Hom_fst_ArrMap_app[cat_cs_simps]:
  assumes "b ∈∘ ℭ⦇Obj⦈" and "f : a ↦op_cat β„­ a'"
  shows "HomO.CΞ±β„­(-,b)⦇ArrMapβ¦ˆβ¦‡f⦈ = cf_hom β„­ [f, ℭ⦇CIdβ¦ˆβ¦‡b⦈]∘"
proof-
  from assms(2) have f: "f ∈∘ op_cat ℭ⦇Arr⦈" by (simp add: cat_cs_intros)
  with category_axioms assms show ?thesis
    unfolding 
      cf_Hom_fst_def
      bifunctor_proj_fst_ArrMap_app[OF category_op category_axioms assms(1) f]
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ArrMap_app


subsubsectionβ€ΉOpposite β€ΉHomβ€Ί-functor projectionsβ€Ί

lemma (in category) cat_op_cat_cf_Hom_snd:
  assumes "a ∈∘ ℭ⦇Obj⦈"
  shows "HomO.CΞ±op_cat β„­(a,-) = HomO.CΞ±β„­(-,a)"
proof(rule cf_eqI[of Ξ±])

  from assms category_axioms show 
    "HomO.CΞ±op_cat β„­(a,-) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"  
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps   
          cs_intro: cat_cs_intros cat_op_intros
      )
  from assms category_axioms show 
    "HomO.CΞ±β„­(-,a) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps   
          cs_intro: cat_cs_intros cat_op_intros
      )

  show "HomO.CΞ±op_cat β„­(a,-)⦇ObjMap⦈ = HomO.CΞ±β„­(-,a)⦇ObjMap⦈"
  proof(rule vsv_eqI)
    from assms category_axioms show "vsv (HomO.CΞ±op_cat β„­(a,-)⦇ObjMap⦈)"
      by (intro is_functor.cf_ObjMap_vsv)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros
        )
    from assms category_axioms show "vsv (HomO.CΞ±β„­(-,a)⦇ObjMap⦈)"
      by (intro is_functor.cf_ObjMap_vsv)
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms category_axioms show 
      "π’Ÿβˆ˜ (HomO.CΞ±op_cat β„­(a,-)⦇ObjMap⦈) = π’Ÿβˆ˜ (HomO.CΞ±β„­(-,a)⦇ObjMap⦈)"
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps   
            cs_intro: cat_cs_intros cat_op_intros
        )
    show "HomO.CΞ±op_cat β„­(a,-)⦇ObjMapβ¦ˆβ¦‡b⦈ = HomO.CΞ±β„­(-,a)⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "b ∈∘ π’Ÿβˆ˜ (HomO.CΞ±op_cat β„­(a,-)⦇ObjMap⦈)" for b
    proof-
      from that have "b ∈∘ ℭ⦇Obj⦈"
        by 
          (
            simp add: 
              category.cat_cf_Hom_snd_ObjMap_vdomain[
                OF category_op, unfolded cat_op_simps, OF assms
                ]
          )
      from category_axioms assms this show ?thesis
        by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros)
    qed
  qed
  
  show "HomO.CΞ±op_cat β„­(a,-)⦇ArrMap⦈ = HomO.CΞ±β„­(-,a)⦇ArrMap⦈"
  proof(rule vsv_eqI)
    from assms category_axioms show "vsv (HomO.CΞ±op_cat β„­(a,-)⦇ArrMap⦈)"
      by (intro is_functor.cf_ArrMap_vsv)
        (cs_concl cs_intro: cat_cs_intros cat_op_intros)
    from assms category_axioms show "vsv (HomO.CΞ±β„­(-,a)⦇ArrMap⦈)"
      by (intro is_functor.cf_ArrMap_vsv)
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms category_axioms show 
      "π’Ÿβˆ˜ (HomO.CΞ±op_cat β„­(a,-)⦇ArrMap⦈) = π’Ÿβˆ˜ (HomO.CΞ±β„­(-,a)⦇ArrMap⦈)"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros)
    show "HomO.CΞ±op_cat β„­(a,-)⦇ArrMapβ¦ˆβ¦‡f⦈ = HomO.CΞ±β„­(-,a)⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "f ∈∘ π’Ÿβˆ˜ (HomO.CΞ±op_cat β„­(a,-)⦇ArrMap⦈)" for f
    proof-
      from that have "f ∈∘ ℭ⦇Arr⦈"
        by 
          (
            simp add: 
              category.cat_cf_Hom_snd_ArrMap_vdomain[
                OF category_op, unfolded cat_op_simps, OF assms
                ]
          )
      then obtain a b where "f : a ↦ℭ b" by auto
      from category_axioms assms this show ?thesis
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )
    qed
  qed

qed simp_all

lemmas [cat_op_simps] = category.cat_op_cat_cf_Hom_snd

lemma (in category) cat_op_cat_cf_Hom_fst:
  assumes "a ∈∘ ℭ⦇Obj⦈"
  shows "HomO.CΞ±op_cat β„­(-,a) = HomO.CΞ±β„­(a,-)"
proof-
  from assms have a: "a ∈∘ op_cat ℭ⦇Obj⦈" unfolding cat_op_simps .
  have "HomO.CΞ±β„­(a,-) = HomO.CΞ±op_cat (op_cat β„­)(a,-)" 
    unfolding cat_op_simps ..
  also have "… = HomO.CΞ±(op_cat β„­)(-,a)"
    unfolding category.cat_op_cat_cf_Hom_snd[OF category_op a] by simp
  finally show "HomO.CΞ±(op_cat β„­)(-,a) = HomO.CΞ±β„­(a,-)" by simp
qed

lemmas [cat_op_simps] = category.cat_op_cat_cf_Hom_fst


subsubsectionβ€Ήβ€ΉHomβ€Ί-functors are injections on objectsβ€Ί

lemma (in category) cat_cf_Hom_snd_inj:
  assumes "HomO.CΞ±β„­(a,-) = HomO.CΞ±β„­(b,-)" 
    and "a ∈∘ ℭ⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
  shows "a = b"
proof(rule ccontr)
  assume prems: "a β‰  b"
  from assms(1) have "HomO.CΞ±β„­(a,-)⦇ObjMapβ¦ˆβ¦‡b⦈ = HomO.CΞ±β„­(b,-)⦇ObjMapβ¦ˆβ¦‡b⦈" 
    by simp
  then have "Hom β„­ a b = Hom β„­ b b"
    unfolding 
      cat_cf_Hom_snd_ObjMap_app[unfolded cat_op_simps, OF assms(2,3)]
      cat_cf_Hom_snd_ObjMap_app[unfolded cat_op_simps, OF assms(3,3)]
    by simp
  with assms prems show False by (force intro: cat_cs_intros)
qed

lemma (in category) cat_cf_Hom_fst_inj:
  assumes "HomO.CΞ±β„­(-,a) = HomO.CΞ±β„­(-,b)" and "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "a = b"
proof(rule ccontr)
  assume prems: "a β‰  b"
  from assms(1) have "HomO.CΞ±β„­(-,a)⦇ObjMapβ¦ˆβ¦‡b⦈ = HomO.CΞ±β„­(-,b)⦇ObjMapβ¦ˆβ¦‡b⦈" 
    by simp
  then have "Hom β„­ b a = Hom β„­ b b"
    unfolding 
      cat_cf_Hom_fst_ObjMap_app[unfolded cat_op_simps, OF assms(2,3)]
      cat_cf_Hom_fst_ObjMap_app[unfolded cat_op_simps, OF assms(3,3)]
    by simp
  with assms prems show False by (force intro: cat_cs_intros)
qed


subsubsectionβ€Ήβ€ΉHomβ€Ί-functor is an array bifunctorβ€Ί

lemma (in category) cat_cf_Hom_is_cf_array:
  ―‹See Chapter II-3 in \cite{mac_lane_categories_2010}.β€Ί
  "HomO.CΞ±β„­(-,-) =
    cf_array (op_cat β„­) β„­ (cat_Set Ξ±) (cf_Hom_fst Ξ± β„­) (cf_Hom_snd Ξ± β„­)"
proof(rule cf_eqI[of Ξ±])

  show "HomO.CΞ±β„­(-,-) : op_cat β„­ Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    by (rule cat_Hom_is_functor)

  have c1: "category Ξ± (op_cat β„­)" by (auto intro: cat_cs_intros)
  have c2: "category Ξ± β„­" by (auto intro: cat_cs_intros)
  have c3: "category Ξ± (cat_Set Ξ±)" by (simp add: category_cat_Set)
  have c4: "HomO.CΞ±β„­(-,c) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    if "c ∈∘ ℭ⦇Obj⦈" for c
    using that by (rule cat_cf_Hom_fst_is_functor)
  have c5: "HomO.CΞ±β„­(b,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    if "b ∈∘ op_cat ℭ⦇Obj⦈" for b
    using that unfolding cat_op_simps by (rule cat_cf_Hom_snd_is_functor)
  have c6: "HomO.CΞ±β„­(b,-)⦇ObjMapβ¦ˆβ¦‡c⦈ = HomO.CΞ±β„­(-,c)⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "b ∈∘ op_cat ℭ⦇Obj⦈" and "c ∈∘ ℭ⦇Obj⦈" for b c
    using that category_axioms
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  have c7: 
    "HomO.CΞ±β„­(b',-)⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Acat_Set Ξ± HomO.CΞ±β„­(-,c)⦇ArrMapβ¦ˆβ¦‡f⦈ =
      HomO.CΞ±β„­(-,c' )⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± HomO.CΞ±β„­(b,- )⦇ArrMapβ¦ˆβ¦‡g⦈"
    if "f : b ↦op_cat β„­ b'" and "g : c ↦ℭ c'" for b c  b'  c' f g 
    using that category_axioms 
    unfolding cat_op_simps
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros
      )
  
  let ?cfa =
    β€Ήcf_array (op_cat β„­) β„­ (cat_Set Ξ±) (cf_Hom_fst Ξ± β„­) (cf_Hom_snd Ξ± β„­)β€Ί

  note cf_array_specification = 
    cf_array_specification[OF c1 c2 c3 c4 c5 c6 c7, simplified]

  from c1 c2 c3 c4 c5 c6 c7 show "?cfa : op_cat β„­ Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    by (rule cf_array_is_functor)

  show "HomO.CΞ±β„­(-,-)⦇ObjMap⦈ = ?cfa⦇ObjMap⦈"
  proof(rule vsv_eqI, unfold cat_cs_simps)
    fix aa' assume "aa' ∈∘ (op_cat β„­ Γ—C β„­)⦇Obj⦈"
    then obtain a a' 
      where aa'_def: "aa' = [a, a']∘" 
        and a: "a ∈∘ op_cat ℭ⦇Obj⦈" 
        and a': "a' ∈∘ ℭ⦇Obj⦈"
      by (elim cat_prod_2_ObjE[OF c1 c2])
    from category_axioms a a' show 
      "HomO.CΞ±β„­(-,-)⦇ObjMapβ¦ˆβ¦‡aa'⦈ = ?cfa⦇ObjMapβ¦ˆβ¦‡aa'⦈"
      unfolding aa'_def cf_array_specification(2)[OF a a'] cat_op_simps
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cs_intro: cat_op_intros cat_prod_cs_intros
        )
  qed (auto simp: cf_array_ObjMap_vsv cf_Hom_ObjMap_vsv cat_cs_simps)

  show "HomO.CΞ±β„­(-,-)⦇ArrMap⦈ = ?cfa⦇ArrMap⦈"
  proof(rule vsv_eqI, unfold cat_cs_simps)
    fix ff' assume "ff' ∈∘ (op_cat β„­ Γ—C β„­)⦇Arr⦈"
    then obtain f f' 
      where ff'_def: "ff' = [f, f']∘" 
        and f: "f ∈∘ op_cat ℭ⦇Arr⦈" 
        and f': "f' ∈∘ ℭ⦇Arr⦈"
      by (elim cat_prod_2_ArrE[OF c1 c2])
    then obtain a b a' b' 
      where f: "f : a ↦op_cat β„­ b" and f': "f' : a' ↦ℭ b'"
      by (blast intro: is_arrI)
    from category_axioms f f' show "cf_hom β„­ ff' = ?cfa⦇ArrMapβ¦ˆβ¦‡ff'⦈"
      unfolding ff'_def cat_op_simps
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros
        )
  qed (auto simp: cf_array_ArrMap_vsv cf_Hom_ArrMap_vsv cat_cs_simps)

qed simp_all


subsubsectionβ€Ή
Projections of the compositions of a β€ΉHomβ€Ί-functor and a functor are
projections of the β€ΉHomβ€Ί-functor
β€Ί

lemma (in category) cat_cf_rcomp_Hom_cf_Hom_snd:
  assumes "π”Š : 𝔅 ↦↦CΞ± β„­" and "a ∈∘ ℭ⦇Obj⦈"
  shows "HomO.CΞ±β„­(-,π”Š-)op_cat β„­,𝔅(a,-)CF = HomO.CΞ±β„­(a,-) ∘CF π”Š"
  using category_axioms assms 
  unfolding cf_rcomp_Hom_def cf_Hom_snd_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

lemmas [cat_cs_simps] = category.cat_cf_rcomp_Hom_cf_Hom_snd

lemma (in category) cat_cf_lcomp_Hom_cf_Hom_snd:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomO.CΞ±β„­(𝔉-,-)op_cat 𝔅,β„­(b,-)CF = HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)"
  using category_axioms assms 
  unfolding cf_lcomp_Hom_def cf_Hom_snd_def
  by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

lemmas [cat_cs_simps] = category.cat_cf_lcomp_Hom_cf_Hom_snd

lemma (in category) cat_cf_rcomp_Hom_cf_Hom_fst:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF = HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
proof-

  from category_axioms assms have H𝔉b:
    "HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_intro: cat_cs_intros)
  from category_axioms assms have H𝔉b':
    "HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_intro: cat_cs_intros)

  from category_axioms assms have [cat_cs_simps]:
    "π’Ÿβˆ˜ ((HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ObjMap⦈) = op_cat ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)+
  from category_axioms assms have [cat_cs_simps]:
    "π’Ÿβˆ˜ (HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ObjMap⦈) = op_cat ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  from category_axioms assms have [cat_cs_simps]:
    "π’Ÿβˆ˜ ((HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ArrMap⦈) = op_cat ℭ⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)+
  from category_axioms assms have [cat_cs_simps]:
    "π’Ÿβˆ˜ (HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ArrMap⦈) = op_cat ℭ⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show ?thesis
  proof(rule cf_eqI[OF H𝔉b H𝔉b'])

    show 
      "(HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ObjMap⦈ = 
        HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold cat_cs_simps)
      from category_axioms assms show 
        "vsv ((HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ObjMap⦈)"
        by (intro bifunctor_proj_fst_ObjMap_vsv[of Ξ±]) 
          (cs_concl cs_intro: cat_cs_intros)+
      from assms show "vsv (HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ObjMap⦈)"
        by (intro cat_cf_Hom_fst_ObjMap_vsv)
          (cs_concl cs_intro: cat_cs_intros)+
      fix a assume prems: "a ∈∘ op_cat ℭ⦇Obj⦈"
      with category_axioms assms show 
        "(HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ObjMapβ¦ˆβ¦‡a⦈ = 
          HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ObjMapβ¦ˆβ¦‡a⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed simp

    show 
      "(HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ArrMap⦈ = 
        HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold cat_cs_simps cat_op_simps)
      from category_axioms assms show 
        "vsv ((HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ArrMap⦈)"
        by (intro bifunctor_proj_fst_ArrMap_vsv[of Ξ±]) 
          (cs_concl cs_intro: cat_cs_intros)+
      from assms show "vsv (HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ArrMap⦈)"
        by (intro cat_cf_Hom_fst_ArrMap_vsv)
          (cs_concl cs_intro: cat_cs_intros)+
      fix f assume "f ∈∘ ℭ⦇Arr⦈"
      then obtain a' b' where "f : a' ↦ℭ b'" by (auto simp: cat_op_simps)
      from category_axioms assms this show 
        "(HomO.CΞ±β„­(-,𝔉-)op_cat β„­,𝔅(-,b)CF)⦇ArrMapβ¦ˆβ¦‡f⦈ = 
          HomO.CΞ±β„­(-,𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ArrMapβ¦ˆβ¦‡f⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed simp

  qed simp_all

qed

lemmas [cat_cs_simps] = category.cat_cf_rcomp_Hom_cf_Hom_fst

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Yoneda

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉYoneda Lemmaβ€Ί
theory CZH_ECAT_Yoneda
  imports 
    CZH_ECAT_FUNCT
    CZH_ECAT_Hom
begin



subsectionβ€ΉYoneda mapβ€Ί


textβ€Ή
The Yoneda map is the bijection that is used in the statement of the
Yoneda Lemma, as presented, for example, in Chapter III-2 in 
\cite{mac_lane_categories_2010} or in subsection 1.15 
in \cite{bodo_categories_1970}.
β€Ί

definition Yoneda_map :: "V β‡’ V β‡’ V β‡’ V"
  where "Yoneda_map Ξ± π”Ž r =
    (
      λψ∈∘these_ntcfs Ξ± (π”Žβ¦‡HomDom⦈) (cat_Set Ξ±) HomO.CΞ±π”Žβ¦‡HomDom⦈(r,-) π”Ž.
        Οˆβ¦‡NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”Žβ¦‡HomDomβ¦ˆβ¦‡CIdβ¦ˆβ¦‡r⦈⦈
    )"


textβ€ΉElementary properties.β€Ί

mk_VLambda Yoneda_map_def
  |vsv Yoneda_map_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) Yoneda_map_def[where Ξ±=Ξ± and π”Ž=𝔉, unfolded cf_HomDom]
  |vdomain Yoneda_map_vdomain|
  |app Yoneda_map_app[unfolded these_ntcfs_iff]|

lemmas [cat_cs_simps] = is_functor.Yoneda_map_vdomain

lemmas Yoneda_map_app[cat_cs_simps] = 
  is_functor.Yoneda_map_app[unfolded these_ntcfs_iff]



subsectionβ€ΉYoneda componentβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The Yoneda components are the components of the natural transformations
that appear in the statement of the Yoneda Lemma (e.g., see 
Chapter III-2 in \cite{mac_lane_categories_2010} or subsection 1.15 
in \cite{bodo_categories_1970}).
β€Ί

definition Yoneda_component :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "Yoneda_component π”Ž r u d =
    [
      (Ξ»f∈∘Hom (π”Žβ¦‡HomDom⦈) r d. π”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡u⦈),
      Hom (π”Žβ¦‡HomDom⦈) r d,
      π”Žβ¦‡ObjMapβ¦ˆβ¦‡d⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma (in is_functor) Yoneda_component_components: 
  shows "Yoneda_component 𝔉 r u d⦇ArrVal⦈ =
    (Ξ»f∈∘Hom 𝔄 r d. 𝔉⦇ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡u⦈)"
    and "Yoneda_component 𝔉 r u d⦇ArrDom⦈ = Hom 𝔄 r d"
    and "Yoneda_component 𝔉 r u d⦇ArrCod⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡d⦈"
  unfolding Yoneda_component_def arr_field_simps 
  by (simp_all add: nat_omega_simps cat_cs_simps)


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda (in is_functor) Yoneda_component_components(1)
  |vsv Yoneda_component_ArrVal_vsv|
  |vdomain Yoneda_component_ArrVal_vdomain|
  |app Yoneda_component_ArrVal_app[unfolded in_Hom_iff]|

lemmas [cat_cs_simps] = is_functor.Yoneda_component_ArrVal_vdomain

lemmas Yoneda_component_ArrVal_app[cat_cs_simps] = 
  is_functor.Yoneda_component_ArrVal_app[unfolded in_Hom_iff]


subsubsectionβ€ΉYoneda component is an arrow in the category β€ΉSetβ€Ίβ€Ί

lemma (in category) cat_Yoneda_component_is_arr:
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "r ∈∘ ℭ⦇Obj⦈"
    and "u ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
    and "d ∈∘ ℭ⦇Obj⦈"
  shows "Yoneda_component π”Ž r u d : Hom β„­ r d ↦cat_Set Ξ± π”Žβ¦‡ObjMapβ¦ˆβ¦‡d⦈"   
proof-
  interpret π”Ž: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί π”Ž by (rule assms(1)) 
  show ?thesis
  proof(intro cat_Set_is_arrI arr_SetI, unfold π”Ž.Yoneda_component_components)
    show "vfsequence (Yoneda_component π”Ž r u d)" 
      unfolding Yoneda_component_def by simp
    show "vcard (Yoneda_component π”Ž r u d) = 3β„•"
      unfolding Yoneda_component_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (Ξ»f∈∘Hom β„­ r d. π”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡u⦈) βŠ†βˆ˜ π”Žβ¦‡ObjMapβ¦ˆβ¦‡d⦈"
    proof(rule vrange_VLambda_vsubset)
      fix f assume "f ∈∘ Hom β„­ r d"
      then have π”Žf: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ : π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈ ↦cat_Set Ξ± π”Žβ¦‡ObjMapβ¦ˆβ¦‡d⦈" 
        by (auto simp: cat_cs_intros)
      note π”Žf_simps = cat_Set_is_arrD[OF π”Žf]
      interpret π”Žf: arr_Set Ξ± β€Ήπ”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ€Ί by (rule π”Žf_simps(1))          
      have "u ∈∘ π’Ÿβˆ˜ (π”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrVal⦈)" 
        by (simp add: π”Žf_simps assms cat_Set_cs_simps)
      with π”Žf.arr_Set_ArrVal_vrange[unfolded π”Žf_simps] show 
        "π”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡u⦈ ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡d⦈"
        by (blast elim: π”Žf.ArrVal.vsv_value)
    qed 
    from assms π”Ž.HomCod.cat_Obj_vsubset_Vset show "π”Žβ¦‡ObjMapβ¦ˆβ¦‡d⦈ ∈∘ Vset Ξ±"
      by (auto dest: π”Ž.cf_ObjMap_app_in_HomCod_Obj)
  qed (auto simp: assms cat_cs_intros)
qed

lemma (in category) cat_Yoneda_component_is_arr':
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±" 
    and "r ∈∘ ℭ⦇Obj⦈"
    and "u ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
    and "d ∈∘ ℭ⦇Obj⦈"
    and "s = Hom β„­ r d"
    and "t = π”Žβ¦‡ObjMapβ¦ˆβ¦‡d⦈"
    and "𝔇 = cat_Set Ξ±"
  shows "Yoneda_component π”Ž r u d : s ↦𝔇 t"   
  unfolding assms(5-7) using assms(1-4) by (rule cat_Yoneda_component_is_arr)

lemmas [cat_cs_intros] = category.cat_Yoneda_component_is_arr'[rotated 1]



subsectionβ€ΉYoneda arrowβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The Yoneda arrows are the natural transformations that 
appear in the statement of the Yoneda Lemma in Chapter III-2 in 
\cite{mac_lane_categories_2010} and subsection 1.15 
in \cite{bodo_categories_1970}.
β€Ί

definition Yoneda_arrow :: "V β‡’ V β‡’ V β‡’ V β‡’ V" 
  where "Yoneda_arrow Ξ± π”Ž r u =
    [
      (Ξ»dβˆˆβˆ˜π”Žβ¦‡HomDomβ¦ˆβ¦‡Obj⦈. Yoneda_component π”Ž r u d),
      HomO.CΞ±π”Žβ¦‡HomDom⦈(r,-),
      π”Ž,
      π”Žβ¦‡HomDom⦈,
      cat_Set Ξ±
    ]∘"


textβ€ΉComponents.β€Ί

lemma (in is_functor) Yoneda_arrow_components:
  shows "Yoneda_arrow Ξ± 𝔉 r u⦇NTMap⦈ = 
    (Ξ»dβˆˆβˆ˜π”„β¦‡Obj⦈. Yoneda_component 𝔉 r u d)"
    and "Yoneda_arrow Ξ± 𝔉 r u⦇NTDom⦈ = HomO.Cα𝔄(r,-)"
    and "Yoneda_arrow Ξ± 𝔉 r u⦇NTCod⦈ = 𝔉"
    and "Yoneda_arrow Ξ± 𝔉 r u⦇NTDGDom⦈ = 𝔄"
    and "Yoneda_arrow Ξ± 𝔉 r u⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding Yoneda_arrow_def nt_field_simps 
  by (simp_all add: nat_omega_simps cat_cs_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda (in is_functor) Yoneda_arrow_components(1)
  |vsv Yoneda_arrow_NTMap_vsv|
  |vdomain Yoneda_arrow_NTMap_vdomain|
  |app Yoneda_arrow_NTMap_app|

lemmas [cat_cs_simps] = is_functor.Yoneda_arrow_NTMap_vdomain

lemmas Yoneda_arrow_NTMap_app[cat_cs_simps] = 
  is_functor.Yoneda_arrow_NTMap_app


subsubsectionβ€ΉYoneda arrow is a natural transformationβ€Ί

lemma (in category) cat_Yoneda_arrow_is_ntcf:
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±" 
    and "r ∈∘ ℭ⦇Obj⦈" 
    and "u ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
  shows "Yoneda_arrow Ξ± π”Ž r u : HomO.CΞ±β„­(r,-) ↦CF π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±"
proof-

  interpret π”Ž: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί π”Ž by (rule assms(1)) 
  note π”Žru = cat_Yoneda_component_is_arr[OF assms]
  let ?π”Žru = β€ΉYoneda_component π”Ž r uβ€Ί

  show ?thesis
  proof(intro is_ntcfI', unfold π”Ž.Yoneda_arrow_components)

    show "vfsequence (Yoneda_arrow Ξ± π”Ž r u)"
      unfolding Yoneda_arrow_def by simp
    show "vcard (Yoneda_arrow Ξ± π”Ž r u) = 5β„•" 
      unfolding Yoneda_arrow_def by (simp add: nat_omega_simps)

    show
      "(Ξ»dβˆˆβˆ˜β„­β¦‡Obj⦈. ?π”Žru d)⦇a⦈ :
        HomO.CΞ±β„­(r,-)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ± π”Žβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using that assms category_axioms
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps V_cs_simps 
            cs_intro: cat_cs_intros
        )
    show 
      "(Ξ»dβˆˆβˆ˜β„­β¦‡Obj⦈. ?π”Žru d)⦇b⦈ ∘Acat_Set Ξ± HomO.CΞ±β„­(r,-)⦇ArrMapβ¦ˆβ¦‡f⦈ =
        π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± (Ξ»dβˆˆβˆ˜β„­β¦‡Obj⦈. ?π”Žru d)⦇a⦈"
      if "f : a ↦ℭ b" for a b f
    proof-

      note 𝔐a = π”Žru[OF cat_is_arrD(2)[OF that]]
      note 𝔐b = π”Žru[OF cat_is_arrD(3)[OF that]]

      from category_axioms assms that 𝔐b have b_f:
        "?π”Žru b ∘Acat_Set Ξ± cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡r⦈, f]∘ :
          Hom β„­ r a ↦cat_Set Ξ± π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by
          (
            cs_concl cs_intro:
              cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      then have dom_lhs: 
        "π’Ÿβˆ˜ ((?π”Žru b ∘Acat_Set Ξ± cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡r⦈, f]∘)⦇ArrVal⦈) =
          Hom β„­ r a"
          by (cs_concl cs_simp: cat_cs_simps)
      from assms that 𝔐a have f_a: 
        "π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?π”Žru a :
          Hom β„­ r a ↦cat_Set Ξ± π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by (cs_concl cs_intro: cat_cs_intros)
      then have dom_rhs: 
        "π’Ÿβˆ˜ ((π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?π”Žru a)⦇ArrVal⦈) = Hom β„­ r a"
        by (cs_concl cs_simp: cat_cs_simps)

      have [cat_cs_simps]:
        "?π”Žru b ∘Acat_Set Ξ± cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡r⦈, f]∘ =
          π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?π”Žru a"
      proof(rule arr_Set_eqI[of Ξ±])

        from b_f show arr_Set_b_f:
          "arr_Set Ξ± (?π”Žru b ∘Acat_Set Ξ± cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡r⦈, f]∘)"
          by (auto simp: cat_Set_is_arrD(1))
        interpret b_f: arr_Set Ξ± β€Ή?π”Žru b ∘Acat_Set Ξ± cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡r⦈, f]βˆ˜β€Ί
          by (rule arr_Set_b_f)
        from f_a show arr_Set_f_a:
          "arr_Set Ξ± (π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?π”Žru a)"
          by (auto simp: cat_Set_is_arrD(1))
        interpret f_a: arr_Set Ξ± β€Ήπ”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?π”Žru aβ€Ί
          by (rule arr_Set_f_a)

        show 
          "(?π”Žru b ∘Acat_Set Ξ± cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡r⦈, f]∘)⦇ArrVal⦈ =
            (π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?π”Žru a)⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
          fix q assume "q : r ↦ℭ a"
          from category_axioms assms that this 𝔐a 𝔐b show 
            "(?π”Žru b ∘Acat_Set Ξ± cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡r⦈, f]∘)⦇ArrValβ¦ˆβ¦‡q⦈ =
              (π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?π”Žru a)⦇ArrValβ¦ˆβ¦‡q⦈"
            by 
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_op_simps
                  cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
              )
        qed (use arr_Set_b_f arr_Set_f_a in auto)

      qed (use b_f f_a in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
  
      from that category_axioms assms 𝔐a 𝔐b show ?thesis
        by
          (
            cs_concl
              cs_simp: V_cs_simps cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros
          )
    
    qed

  qed (auto simp: assms(2) cat_cs_intros)

qed



subsectionβ€ΉYoneda Lemmaβ€Ί

textβ€Ή
The following lemma is approximately equivalent to the Yoneda Lemma 
stated in subsection 1.15 in \cite{bodo_categories_1970} 
(the first two conclusions correspond to the statement of the 
Yoneda lemma in Chapter III-2 in \cite{mac_lane_categories_2010}).
β€Ί

lemma (in category) cat_Yoneda_Lemma: 
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±" and "r ∈∘ ℭ⦇Obj⦈"
  shows "v11 (Yoneda_map Ξ± π”Ž r)" 
    and "β„›βˆ˜ (Yoneda_map Ξ± π”Ž r) = π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
    and "(Yoneda_map Ξ± π”Ž r)¯∘ = (Ξ»uβˆˆβˆ˜π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈. Yoneda_arrow Ξ± π”Ž r u)"
proof-

  interpret π”Ž: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί π”Ž by (rule assms(1)) 

  from assms(2) π”Ž.HomCod.cat_Obj_vsubset_Vset π”Ž.cf_ObjMap_app_in_HomCod_Obj 
  have π”Žr_in_Vset: "π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈ ∈∘ Vset Ξ±"
    by auto

  show Ym: "v11 (Yoneda_map Ξ± π”Ž r)"
  proof(intro vsv.vsv_valeq_v11I, unfold π”Ž.Yoneda_map_vdomain these_ntcfs_iff)

    fix 𝔐 𝔑
    assume prems: 
      "𝔐 : HomO.CΞ±β„­(r,-) ↦CF π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±"
      "𝔑 : HomO.CΞ±β„­(r,-) ↦CF π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±"
      "Yoneda_map Ξ± π”Ž rβ¦‡π”β¦ˆ = Yoneda_map Ξ± π”Ž rβ¦‡π”‘β¦ˆ"
    from prems(3) have 𝔐r_𝔑r:
      "𝔐⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
      unfolding 
        Yoneda_map_app[OF assms(1) prems(1)] 
        Yoneda_map_app[OF assms(1) prems(2)]
      by simp

    interpret 𝔐: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(r,-)β€Ί π”Ž 𝔐  
      by (rule prems(1))
    interpret 𝔑: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(r,-)β€Ί π”Ž 𝔑 
      by (rule prems(2))

    show "𝔐 = 𝔑"
    proof
      (
        rule ntcf_eqI[OF prems(1,2)]; 
        (rule refl)?;
        rule vsv_eqI, 
        unfold 𝔐.ntcf_NTMap_vdomain 𝔑.ntcf_NTMap_vdomain
      )

      fix d assume prems': "d ∈∘ ℭ⦇Obj⦈"

      note 𝔐d_simps = cat_Set_is_arrD[OF 𝔐.ntcf_NTMap_is_arr[OF prems']]
      interpret 𝔐d: arr_Set Ξ± ‹𝔐⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ€Ί by (rule 𝔐d_simps(1))

      note 𝔑d_simps = cat_Set_is_arrD[OF 𝔑.ntcf_NTMap_is_arr[OF prems']]
      interpret 𝔑d: arr_Set Ξ± ‹𝔑⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ€Ί by (rule 𝔑d_simps(1))

      show "𝔐⦇NTMapβ¦ˆβ¦‡d⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡d⦈"
      proof(rule arr_Set_eqI[of Ξ±])
        show "𝔐⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ¦‡ArrVal⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ¦‡ArrVal⦈"
        proof
          (
            rule vsv_eqI, 
            unfold 
              𝔑d.arr_Set_ArrVal_vdomain 
              𝔐d.arr_Set_ArrVal_vdomain  
              𝔐d_simps
              𝔑d_simps
          )
          fix f assume prems'': "f ∈∘ HomO.CΞ±β„­(r,-)⦇ObjMapβ¦ˆβ¦‡d⦈"
          from prems'' prems' category_axioms assms(2) have f: "f : r ↦ℭ d"
            by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_op_intros)
          from 𝔐.ntcf_Comp_commute[OF f] have 
            "(
              𝔐⦇NTMapβ¦ˆβ¦‡d⦈ ∘Acat_Set Ξ± HomO.CΞ±β„­(r,-)⦇ArrMapβ¦ˆβ¦‡f⦈
            )⦇ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈ =
              (π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± 𝔐⦇NTMapβ¦ˆβ¦‡r⦈)⦇ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
            by simp
          from this category_axioms assms(2) f prems prems' have 𝔐df:
            "𝔐⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈ =
              π”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”β¦‡NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈⦈"
            by 
              (
                cs_prems
                  cs_simp: cat_cs_simps cat_op_simps 
                  cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
              )
          from 𝔑.ntcf_Comp_commute[OF f] have
            "(
              𝔑⦇NTMapβ¦ˆβ¦‡d⦈ ∘Acat_Set Ξ± 
              HomO.CΞ±β„­(r,-)⦇ArrMapβ¦ˆβ¦‡f⦈
            )⦇ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈ = 
              (π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± 𝔑⦇NTMapβ¦ˆβ¦‡r⦈)⦇ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
            by simp
          from this category_axioms assms(2) f prems prems' have 𝔑df:
            "𝔑⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈ =
              π”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‘β¦‡NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈⦈"
            by
              (
                cs_prems
                  cs_simp: cat_cs_simps cat_op_simps 
                  cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
              )
          show "𝔐⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡dβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈"
            unfolding 𝔐df 𝔑df 𝔐r_𝔑r by simp
        qed auto

      qed (simp_all add: 𝔐d_simps 𝔑d_simps)

    qed auto

  qed (auto simp: Yoneda_map_vsv)

  interpret Ym: v11 β€ΉYoneda_map Ξ± π”Ž rβ€Ί by (rule Ym)

  have YY: "Yoneda_map Ξ± π”Ž r⦇Yoneda_arrow Ξ± π”Ž r a⦈ = a" 
    if "a ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈" for a
  proof-
    note cat_Yoneda_arrow_is_ntcf[OF assms that]
    moreover with assms have Ya: "Yoneda_arrow Ξ± π”Ž r a ∈∘ π’Ÿβˆ˜ (Yoneda_map Ξ± π”Ž r)" 
      by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
    ultimately show "Yoneda_map Ξ± π”Ž r⦇Yoneda_arrow Ξ± π”Ž r a⦈ = a"
      using assms that π”Žr_in_Vset
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed        

  show [simp]: "β„›βˆ˜ (Yoneda_map Ξ± π”Ž r) = π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
  proof(intro vsubset_antisym)

    show "β„›βˆ˜ (Yoneda_map Ξ± π”Ž r) βŠ†βˆ˜ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
      unfolding Yoneda_map_def
    proof(intro vrange_VLambda_vsubset, unfold these_ntcfs_iff π”Ž.cf_HomDom)
      fix 𝔐 assume prems: "𝔐 : HomO.CΞ±β„­(r,-) ↦CF π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±"
      then interpret 𝔐: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(r,-)β€Ί π”Ž 𝔐 .
      note 𝔐r_simps = cat_Set_is_arrD[OF 𝔐.ntcf_NTMap_is_arr[OF assms(2)]]
      interpret 𝔐r: arr_Set Ξ± ‹𝔐⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ€Ί by (rule 𝔐r_simps(1))
      from prems category_axioms assms(2) have 
        "ℭ⦇CIdβ¦ˆβ¦‡r⦈ ∈∘ π’Ÿβˆ˜ (𝔐⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrVal⦈)"
        unfolding 𝔐r.arr_Set_ArrVal_vdomain 𝔐r_simps
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
      then have "𝔐⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈ ∈∘ β„›βˆ˜ (𝔐⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrVal⦈)"
        by (blast elim: 𝔐r.ArrVal.vsv_value)
      then show "𝔐⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡r⦈⦈ ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
        by (auto simp: 𝔐r_simps dest!: vsubsetD[OF 𝔐r.arr_Set_ArrVal_vrange])
    qed
    
    show "π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈ βŠ†βˆ˜ β„›βˆ˜ (Yoneda_map Ξ± π”Ž r)"
    proof(intro vsubsetI)
      fix u assume prems: "u ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
      from cat_Yoneda_arrow_is_ntcf[OF assms prems] have 
        "Yoneda_arrow Ξ± π”Ž r u ∈∘ π’Ÿβˆ˜ (Yoneda_map Ξ± π”Ž r)" 
        by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
      with YY[OF prems] show "u ∈∘ β„›βˆ˜ (Yoneda_map Ξ± π”Ž r)" 
        by (force dest!: vdomain_atD)
    qed

  qed

  show "(Yoneda_map Ξ± π”Ž r)¯∘ = (Ξ»uβˆˆβˆ˜π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈. Yoneda_arrow Ξ± π”Ž r u)"
  proof(rule vsv_eqI, unfold vdomain_vconverse vdomain_VLambda)
    from Ym show "vsv ((Yoneda_map Ξ± π”Ž r)¯∘)" by auto
    show "(Yoneda_map Ξ± π”Ž r)Β―βˆ˜β¦‡a⦈ = (Ξ»uβˆˆβˆ˜π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈. Yoneda_arrow Ξ± π”Ž r u)⦇a⦈"
      if "a ∈∘ β„›βˆ˜ (Yoneda_map Ξ± π”Ž r)" for a
    proof-
      from that have a: "a ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈" by simp
      note Ya = cat_Yoneda_arrow_is_ntcf[OF assms a]
      then have "Yoneda_arrow Ξ± π”Ž r a ∈∘ π’Ÿβˆ˜ (Yoneda_map Ξ± π”Ž r)"
        by 
          (
            cs_concl 
              cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
          )
      with Ya YY[OF a] a show ?thesis
        by 
          (
            intro Ym.v11_vconverse_app[
              unfolded π”Ž.Yoneda_map_vdomain these_ntcfs_iff
              ]
          )
          (simp_all add: these_ntcfs_iff cat_cs_simps)
    qed
  qed auto

qed



subsectionβ€ΉInverse of the Yoneda mapβ€Ί

lemma (in category) inv_Yoneda_map_v11: 
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±" and "r ∈∘ ℭ⦇Obj⦈"
  shows "v11 ((Yoneda_map Ξ± π”Ž r)¯∘)"
  using cat_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)

lemma (in category) inv_Yoneda_map_vdomain: 
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±" and "r ∈∘ ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ ((Yoneda_map Ξ± π”Ž r)¯∘) = π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
  unfolding cat_Yoneda_Lemma(3)[OF assms] by simp

lemmas [cat_cs_simps] = category.inv_Yoneda_map_vdomain

lemma (in category) inv_Yoneda_map_app: 
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±" and "r ∈∘ ℭ⦇Obj⦈" and "u ∈∘ π”Žβ¦‡ObjMapβ¦ˆβ¦‡r⦈"
  shows "(Yoneda_map Ξ± π”Ž r)Β―βˆ˜β¦‡u⦈ = Yoneda_arrow Ξ± π”Ž r u"
  using assms(3) unfolding cat_Yoneda_Lemma(3)[OF assms(1,2)] by simp

lemmas [cat_cs_simps] = category.inv_Yoneda_map_app

lemma (in category) inv_Yoneda_map_vrange: 
  assumes "π”Ž : β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "β„›βˆ˜ ((Yoneda_map Ξ± π”Ž r)¯∘) =
    these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(r,-) π”Ž"
proof-
  interpret π”Ž: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί π”Ž by (rule assms(1)) 
  show ?thesis unfolding Yoneda_map_def by (simp add: cat_cs_simps)
qed



subsectionβ€Ή
Component of a composition of a β€ΉHomβ€Ί-natural transformation 
with natural transformations
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The following definition is merely a technical generalization
that is used in the context of the description of the 
composition of a β€ΉHomβ€Ί-natural transformation with a natural transformation
later in this section
(also see subsection 1.15 in \cite{bodo_categories_1970}).
β€Ί

definition ntcf_Hom_component :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_Hom_component Ο† ψ a b =
    [
      (
        Ξ»f∈∘Hom (φ⦇NTDGCod⦈) (φ⦇NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (Οˆβ¦‡NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡b⦈).
          Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈ ∘AΟˆβ¦‡NTDGCod⦈ f ∘AΟˆβ¦‡NTDGCod⦈ φ⦇NTMapβ¦ˆβ¦‡a⦈
      ),
      Hom (φ⦇NTDGCod⦈) (φ⦇NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (Οˆβ¦‡NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡b⦈),
      Hom (φ⦇NTDGCod⦈) (φ⦇NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (Οˆβ¦‡NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡b⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_Hom_component_components: 
  shows "ntcf_Hom_component Ο† ψ a b⦇ArrVal⦈ =
    (
      Ξ»f∈∘Hom (φ⦇NTDGCod⦈) (φ⦇NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (Οˆβ¦‡NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡b⦈).
        Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈ ∘AΟˆβ¦‡NTDGCod⦈ f ∘AΟˆβ¦‡NTDGCod⦈ φ⦇NTMapβ¦ˆβ¦‡a⦈
    )"
    and "ntcf_Hom_component Ο† ψ a b⦇ArrDom⦈ =
      Hom (φ⦇NTDGCod⦈) (φ⦇NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (Οˆβ¦‡NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
    and "ntcf_Hom_component Ο† ψ a b⦇ArrCod⦈ =
      Hom (φ⦇NTDGCod⦈) (φ⦇NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (Οˆβ¦‡NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
  unfolding ntcf_Hom_component_def arr_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda ntcf_Hom_component_components(1)
  |vsv ntcf_Hom_component_ArrVal_vsv[intro]|

context
  fixes Ξ± Ο† ψ 𝔉 π”Š 𝔉' π”Š' 𝔄 𝔅 β„­
  assumes Ο†: "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and ψ: "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
begin

interpretation Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule Ο†)
interpretation ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule ψ)

mk_VLambda 
  ntcf_Hom_component_components(1)
    [
      of Ο† ψ, 
      unfolded 
        Ο†.ntcf_NTDom ψ.ntcf_NTDom 
        Ο†.ntcf_NTCod ψ.ntcf_NTCod 
        Ο†.ntcf_NTDGDom ψ.ntcf_NTDGDom
        Ο†.ntcf_NTDGCod ψ.ntcf_NTDGCod
    ]
  |vdomain ntcf_Hom_component_ArrVal_vdomain|
  |app ntcf_Hom_component_ArrVal_app[unfolded in_Hom_iff]|

lemmas [cat_cs_simps] = 
  ntcf_Hom_component_ArrVal_vdomain
  ntcf_Hom_component_ArrVal_app

lemma ntcf_Hom_component_ArrVal_vrange:
  assumes "a ∈∘ 𝔄⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "β„›βˆ˜ (ntcf_Hom_component Ο† ψ a b⦇ArrVal⦈) βŠ†βˆ˜
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (π”Š'⦇ObjMapβ¦ˆβ¦‡b⦈)"
proof
  (
    rule vsv.vsv_vrange_vsubset, 
    unfold ntcf_Hom_component_ArrVal_vdomain in_Hom_iff
  )
  fix f assume "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ 𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈"
  with assms Ο† ψ show 
    "ntcf_Hom_component Ο† ψ a b⦇ArrValβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ π”Š'⦇ObjMapβ¦ˆβ¦‡b⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (rule ntcf_Hom_component_ArrVal_vsv)

end


subsubsectionβ€ΉArrow domain and codomainβ€Ί

context
  fixes Ξ± Ο† ψ 𝔉 π”Š 𝔉' π”Š' 𝔄 𝔅 β„­
  assumes Ο†: "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and ψ: "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
begin

interpretation Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule Ο†)
interpretation ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule ψ)

lemma ntcf_Hom_component_ArrDom[cat_cs_simps]:
  "ntcf_Hom_component Ο† ψ a b⦇ArrDom⦈ = Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)"
  unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)

lemma ntcf_Hom_component_ArrCod[cat_cs_simps]:
  "ntcf_Hom_component Ο† ψ a b⦇ArrCod⦈ = Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (π”Š'⦇ObjMapβ¦ˆβ¦‡b⦈)"
  unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)

end


subsubsectionβ€Ή
Component of a composition of a β€ΉHomβ€Ί-natural transformation 
with natural transformations is an arrow in the category β€ΉSetβ€Ί
β€Ί

lemma (in category) cat_ntcf_Hom_component_is_arr:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "ntcf_Hom_component Ο† ψ a b :
      Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ±
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (π”Š'⦇ObjMapβ¦ˆβ¦‡b⦈)"
proof-
  
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule assms(2))

  from assms have a: "a ∈∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp

  show ?thesis
  proof(intro cat_Set_is_arrI arr_SetI)
    show "vfsequence (ntcf_Hom_component Ο† ψ a b)"
      unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
    show "vcard (ntcf_Hom_component Ο† ψ a b) = 3β„•"
      unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
    from assms ntcf_Hom_component_ArrVal_vrange[OF assms(1,2) a assms(4)] show 
      "β„›βˆ˜ (ntcf_Hom_component Ο† ψ a b⦇ArrVal⦈) βŠ†βˆ˜ 
        ntcf_Hom_component Ο† ψ a b⦇ArrCod⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    from assms(1,2,4) a show "ntcf_Hom_component Ο† ψ a b⦇ArrDom⦈ ∈∘ Vset Ξ±"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(1,2,4) a show "ntcf_Hom_component Ο† ψ a b⦇ArrCod⦈ ∈∘ Vset Ξ±"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (use assms in β€Ήauto simp: ntcf_Hom_component_components cat_cs_simpsβ€Ί)

qed

lemma (in category) cat_ntcf_Hom_component_is_arr':
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "𝔄' = Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)"
    and "𝔅' = Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (π”Š'⦇ObjMapβ¦ˆβ¦‡b⦈)"
    and "β„­' = cat_Set Ξ±"
  shows "ntcf_Hom_component Ο† ψ a b : 𝔄' ↦ℭ' 𝔅'"
  using assms(1-4) unfolding assms(5-7) by (rule cat_ntcf_Hom_component_is_arr)
  
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_component_is_arr'


subsubsectionβ€Ή
Naturality of the components of a composition of 
a β€ΉHomβ€Ί-natural transformation with natural transformations
β€Ί

lemma (in category) cat_ntcf_Hom_component_nat:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
    and "g : a ↦op_cat 𝔄 a'"
    and "f : b ↦𝔅 b'" 
  shows
    "ntcf_Hom_component Ο† ψ a' b' ∘Acat_Set Ξ±
     cf_hom β„­ [π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈, 𝔉'⦇ArrMapβ¦ˆβ¦‡f⦈]∘ =
      cf_hom β„­ [𝔉⦇ArrMapβ¦ˆβ¦‡g⦈, π”Š'⦇ArrMapβ¦ˆβ¦‡f⦈]∘ ∘Acat_Set Ξ±
      ntcf_Hom_component Ο† ψ a b"
proof-

  let ?Y_ab = β€Ήntcf_Hom_component Ο† ψ a bβ€Ί
    and ?Y_a'b' = β€Ήntcf_Hom_component Ο† ψ a' b'β€Ί
    and ?π”Šg = β€Ήπ”Šβ¦‡ArrMapβ¦ˆβ¦‡gβ¦ˆβ€Ί
    and ?𝔉'f = ‹𝔉'⦇ArrMapβ¦ˆβ¦‡fβ¦ˆβ€Ί
    and ?𝔉g = ‹𝔉⦇ArrMapβ¦ˆβ¦‡gβ¦ˆβ€Ί
    and ?π”Š'f = β€Ήπ”Š'⦇ArrMapβ¦ˆβ¦‡fβ¦ˆβ€Ί
    and ?π”Ša = β€Ήπ”Šβ¦‡ObjMapβ¦ˆβ¦‡aβ¦ˆβ€Ί
    and ?𝔉'b = ‹𝔉'⦇ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί
    and ?𝔉a' = ‹𝔉⦇ObjMapβ¦ˆβ¦‡a'β¦ˆβ€Ί
    and ?π”Š'b' = β€Ήπ”Š'⦇ObjMapβ¦ˆβ¦‡b'β¦ˆβ€Ί

  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule assms(2))
  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)

  from assms(3) have g: "g : a' ↦𝔄 a" unfolding cat_op_simps by simp

  from Set.category_axioms category_axioms assms g have a'b_Gg𝔉'f:
    "?Y_a'b' ∘Acat_Set Ξ± cf_hom β„­ [?π”Šg, ?𝔉'f]∘ :
      Hom β„­ ?π”Ša ?𝔉'b ↦cat_Set Ξ± Hom β„­ ?𝔉a' ?π”Š'b'"
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_lhs: 
    "π’Ÿβˆ˜ ((?Y_a'b' ∘Acat_Set Ξ± cf_hom β„­ [?π”Šg, ?𝔉'f]∘)⦇ArrVal⦈) = 
      Hom β„­ ?π”Ša ?𝔉'b"
    by (cs_concl cs_simp: cat_cs_simps)
  from Set.category_axioms category_axioms assms g have 𝔉gπ”Š'f_ab: 
    "cf_hom β„­ [?𝔉g, ?π”Š'f]∘ ∘Acat_Set Ξ± ?Y_ab : 
      Hom β„­ ?π”Ša ?𝔉'b ↦cat_Set Ξ± Hom β„­ ?𝔉a' ?π”Š'b'"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_rhs: 
    "π’Ÿβˆ˜ ((cf_hom β„­ [?𝔉g, ?π”Š'f]∘ ∘Acat_Set Ξ± ?Y_ab)⦇ArrVal⦈) =
      Hom β„­ ?π”Ša ?𝔉'b"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from a'b_Gg𝔉'f show arr_Set_a'b_Gg𝔉'f:
      "arr_Set Ξ± (?Y_a'b' ∘Acat_Set Ξ± cf_hom β„­ [?π”Šg, ?𝔉'f]∘)"
      by (auto dest: cat_Set_is_arrD(1))
    from 𝔉gπ”Š'f_ab show arr_Set_𝔉gπ”Š'f_ab: 
      "arr_Set Ξ± (cf_hom β„­ [?𝔉g, ?π”Š'f]∘ ∘Acat_Set Ξ± ?Y_ab)"
      by (auto dest: cat_Set_is_arrD(1))
    show 
      "(?Y_a'b' ∘Acat_Set Ξ± cf_hom β„­ [?π”Šg, ?𝔉'f]∘)⦇ArrVal⦈ =
        (cf_hom β„­ [?𝔉g, ?π”Š'f]∘ ∘Acat_Set Ξ± ?Y_ab)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume prems: "h : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ 𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈"
      from assms(1,2) g have [cat_cs_simps]:
        "Οˆβ¦‡NTMapβ¦ˆβ¦‡b'⦈ ∘Aβ„­ (?𝔉'f ∘Aβ„­ (h ∘Aβ„­ (?π”Šg ∘Aβ„­ φ⦇NTMapβ¦ˆβ¦‡a'⦈))) =
          Οˆβ¦‡NTMapβ¦ˆβ¦‡b'⦈ ∘Aβ„­ (?𝔉'f ∘Aβ„­ (h ∘Aβ„­ (φ⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ ?𝔉g)))"
        by (cs_concl cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros)
      also from assms(1,2,4) prems g have "… =
        (((Οˆβ¦‡NTMapβ¦ˆβ¦‡b'⦈ ∘Aβ„­ ?𝔉'f) ∘Aβ„­ h) ∘Aβ„­ φ⦇NTMapβ¦ˆβ¦‡a⦈) ∘Aβ„­ ?𝔉g"
        by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros) (*slow*)
      also from assms(1,2,4) have "… =
        (((?π”Š'f ∘Aβ„­ Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈) ∘Aβ„­ h) ∘Aβ„­ φ⦇NTMapβ¦ˆβ¦‡a⦈) ∘Aβ„­ ?𝔉g"
        by (cs_concl cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros)
      also from assms(1,2,4) prems g have "… =
        ?π”Š'f ∘Aβ„­ (Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ (h ∘Aβ„­ (φ⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ ?𝔉g)))"
        by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros) (*slow*)
      finally have nat:
        "Οˆβ¦‡NTMapβ¦ˆβ¦‡b'⦈ ∘Aβ„­ (?𝔉'f ∘Aβ„­ (h ∘Aβ„­ (?π”Šg ∘Aβ„­ φ⦇NTMapβ¦ˆβ¦‡a'⦈))) =
          ?π”Š'f ∘Aβ„­ (Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ (h ∘Aβ„­ (φ⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ ?𝔉g)))".
      from prems Set.category_axioms category_axioms assms(1,2,4) g show 
        "(?Y_a'b' ∘Acat_Set Ξ± cf_hom β„­ [?π”Šg, ?𝔉'f]∘)⦇ArrValβ¦ˆβ¦‡h⦈ =
          (cf_hom β„­ [?𝔉g, ?π”Š'f]∘ ∘Acat_Set Ξ± ?Y_ab)⦇ArrValβ¦ˆβ¦‡h⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp: nat cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed (use arr_Set_a'b_Gg𝔉'f arr_Set_𝔉gπ”Š'f_ab in auto)

  qed (use a'b_Gg𝔉'f 𝔉gπ”Š'f_ab in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed


subsubsectionβ€Ή
Composition of the components of a composition of a β€ΉHomβ€Ί-natural 
transformation with natural transformations
β€Ί

lemma (in category) cat_ntcf_Hom_component_Comp:
  assumes "Ο†' : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± β„­" 
    and "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "ψ' : π”Š' ↦CF β„Œ' : 𝔅 ↦↦CΞ± β„­" 
    and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "ntcf_Hom_component Ο† ψ' a b ∘Acat_Set Ξ± ntcf_Hom_component Ο†' ψ a b =
      ntcf_Hom_component (Ο†' βˆ™NTCF Ο†) (ψ' βˆ™NTCF ψ) a b"
    (is β€Ή?Ο†Οˆ' ∘Acat_Set Ξ± ?Ο†'ψ = ?Ο†'Ο†Οˆ'Οˆβ€Ί)
proof-

  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)

  from assms Set.category_axioms category_axioms have Ο†Οˆ'_Ο†'ψ: 
    "?Ο†Οˆ' ∘Acat_Set Ξ± ?Ο†'ψ :
      Hom β„­ (β„Œβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ±
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (β„Œ'⦇ObjMapβ¦ˆβ¦‡b⦈)"    
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  then have dom_lhs: 
    "π’Ÿβˆ˜ ((?Ο†Οˆ' ∘Acat_Set Ξ± ?Ο†'ψ)⦇ArrVal⦈) = 
      Hom β„­ (β„Œβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)"
    by (cs_concl cs_simp: cat_cs_simps)
  from assms Set.category_axioms category_axioms have Ο†'Ο†Οˆ'ψ: 
    "?Ο†'Ο†Οˆ'ψ :
      Hom β„­ (β„Œβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ±
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (β„Œ'⦇ObjMapβ¦ˆβ¦‡b⦈)"    
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  then have dom_rhs: 
    "π’Ÿβˆ˜ (?Ο†'Ο†Οˆ'Οˆβ¦‡ArrVal⦈) = Hom β„­ (β„Œβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)" 
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from Ο†Οˆ'_Ο†'ψ show arr_Set_Ο†Οˆ'_Ο†'ψ: "arr_Set Ξ± (?Ο†Οˆ' ∘Acat_Set Ξ± ?Ο†'ψ)"
      by (auto dest: cat_Set_is_arrD(1))
    from Ο†'Ο†Οˆ'ψ show arr_Set_Ο†'Ο†Οˆ'ψ: "arr_Set Ξ± ?Ο†'Ο†Οˆ'ψ"
      by (auto dest: cat_Set_is_arrD(1))
    show "(?Ο†Οˆ' ∘Acat_Set Ξ± ?Ο†'ψ)⦇ArrVal⦈ = ?Ο†'Ο†Οˆ'Οˆβ¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix f assume "f : β„Œβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ 𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈"
      with category_axioms assms Set.category_axioms show 
        "(?Ο†Οˆ' ∘Acat_Set Ξ± ?Ο†'ψ)⦇ArrValβ¦ˆβ¦‡f⦈ = ?Ο†'Ο†Οˆ'Οˆβ¦‡ArrValβ¦ˆβ¦‡f⦈"
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed (use arr_Set_Ο†'Ο†Οˆ'ψ arr_Set_Ο†Οˆ'_Ο†'ψ in auto)
    
  qed (use Ο†Οˆ'_Ο†'ψ Ο†'Ο†Οˆ'ψ in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_Comp


subsubsectionβ€Ή
Component of a composition of β€ΉHomβ€Ί-natural 
transformation with the identity natural transformations
β€Ί

lemma (in category) cat_ntcf_Hom_component_ntcf_id:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­" 
    and "𝔉': 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "ntcf_Hom_component (ntcf_id 𝔉) (ntcf_id 𝔉') a b =
      cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)⦈"
    (is β€Ή?𝔉𝔉' = cat_Set α⦇CIdβ¦ˆβ¦‡?𝔉a𝔉'bβ¦ˆβ€Ί)
proof-

  interpret 𝔉: is_functor Ξ± 𝔄 β„­ 𝔉 by (rule assms(1))
  interpret 𝔉': is_functor Ξ± 𝔅 β„­ 𝔉' by (rule assms(2))
  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)

  from assms Set.category_axioms category_axioms have 𝔉𝔉': 
    "?𝔉𝔉' :
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ±
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)"    
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  then have dom_lhs: "π’Ÿβˆ˜ (?𝔉𝔉'⦇ArrVal⦈) = Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)"
    by (cs_concl cs_simp: cat_cs_simps)

  from category_axioms assms Set.category_axioms have 𝔉a𝔉'b: 
    "cat_Set α⦇CIdβ¦ˆβ¦‡?𝔉a𝔉'b⦈ :
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ±
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)"
    by 
      (
        cs_concl cs_full 
          cs_simp: cat_Set_cs_simps cat_Set_components(1) 
          cs_intro: cat_cs_intros
      )
  then have dom_rhs: 
    "π’Ÿβˆ˜ (cat_Set α⦇CIdβ¦ˆβ¦‡?𝔉a𝔉'bβ¦ˆβ¦‡ArrVal⦈) = Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from 𝔉𝔉' show arr_Set_π”‰Οˆ: "arr_Set Ξ± ?𝔉𝔉'" 
      by (auto dest: cat_Set_is_arrD(1))
    from 𝔉a𝔉'b show arr_Set_𝔉a𝔉'b: "arr_Set Ξ± (cat_Set α⦇CIdβ¦ˆβ¦‡?𝔉a𝔉'b⦈)" 
      by (auto dest: cat_Set_is_arrD(1))
    show "?𝔉𝔉'⦇ArrVal⦈ = cat_Set α⦇CIdβ¦ˆβ¦‡?𝔉a𝔉'bβ¦ˆβ¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)  
      fix f assume "f : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ 𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈"
      with category_axioms Set.category_axioms assms show 
        "?𝔉𝔉'⦇ArrValβ¦ˆβ¦‡f⦈ = cat_Set α⦇CIdβ¦ˆβ¦‡?𝔉a𝔉'bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros) 
    qed (use arr_Set_𝔉a𝔉'b in auto)
      
  qed (use 𝔉𝔉' 𝔉a𝔉'b in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_ntcf_id



subsectionβ€Ή
Component of a composition of a β€ΉHomβ€Ί-natural transformation 
with a natural transformation
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition ntcf_lcomp_Hom_component :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcf_lcomp_Hom_component Ο† a b =
    ntcf_Hom_component Ο† (ntcf_id (cf_id (φ⦇NTDGCod⦈))) a b"

definition ntcf_rcomp_Hom_component :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcf_rcomp_Hom_component ψ a b =
    ntcf_Hom_component (ntcf_id (cf_id (Οˆβ¦‡NTDGCod⦈))) ψ a b"


subsubsectionβ€ΉArrow valueβ€Ί

lemma ntcf_lcomp_Hom_component_ArrVal_vsv: 
  "vsv (ntcf_lcomp_Hom_component Ο† a b⦇ArrVal⦈)"
  unfolding ntcf_lcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)

lemma ntcf_rcomp_Hom_component_ArrVal_vsv: 
  "vsv (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈)"
  unfolding ntcf_rcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)

lemma ntcf_lcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]: 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" and "b ∈∘ ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ (ntcf_lcomp_Hom_component Ο† a b⦇ArrVal⦈) = Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) b"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  show ?thesis
    using assms
    unfolding ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]: 
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" and "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) = Hom β„­ a (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  show ?thesis
    using assms
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_component_ArrVal_app[cat_cs_simps]: 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
    and "h : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ b"
  shows "ntcf_lcomp_Hom_component Ο† a b⦇ArrValβ¦ˆβ¦‡h⦈ = h ∘Aβ„­ φ⦇NTMapβ¦ˆβ¦‡a⦈"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  show ?thesis
    using assms
    unfolding cat_op_simps ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrVal_app[cat_cs_simps]: 
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat ℭ⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "h : a ↦ℭ 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
  shows "ntcf_rcomp_Hom_component ψ a b⦇ArrValβ¦ˆβ¦‡h⦈ = Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ h"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  show ?thesis
    using assms
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_component_ArrVal_vrange: 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
  shows "β„›βˆ˜ (ntcf_lcomp_Hom_component Ο† a b⦇ArrVal⦈) βŠ†βˆ˜ Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) b"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms(2) have a: "a ∈∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "β„›βˆ˜ (ntcf_lcomp_Hom_component Ο† a b⦇ArrVal⦈) βŠ†βˆ˜
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (cf_id ℭ⦇ObjMapβ¦ˆβ¦‡b⦈)"
    by 
      (
        unfold cat_op_simps ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod, 
        intro ntcf_Hom_component_ArrVal_vrange
      ) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
  from this assms(3) show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed

lemma ntcf_rcomp_Hom_component_ArrVal_vrange: 
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat ℭ⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "β„›βˆ˜ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) βŠ†βˆ˜ Hom β„­ a (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  from assms(2) have a: "a ∈∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "β„›βˆ˜ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) βŠ†βˆ˜
      Hom β„­ (cf_id ℭ⦇ObjMapβ¦ˆβ¦‡a⦈) (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
    by 
      (
        unfold ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod, 
        intro ntcf_Hom_component_ArrVal_vrange
      ) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from this a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed


subsubsectionβ€ΉArrow domain and codomainβ€Ί

lemma ntcf_lcomp_Hom_component_ArrDom[cat_cs_simps]:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" and "b ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_lcomp_Hom_component Ο† a b⦇ArrDom⦈ = Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) b"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrDom[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" and "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "ntcf_rcomp_Hom_component ψ a b⦇ArrDom⦈ = Hom β„­ a (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  from assms show ?thesis
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_component_ArrCod[cat_cs_simps]:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" and "b ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_lcomp_Hom_component Ο† a b⦇ArrCod⦈ = Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) b"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrCod[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" and "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "ntcf_rcomp_Hom_component ψ a b⦇ArrCod⦈ = Hom β„­ a (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)" 
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  from assms show ?thesis
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed


subsubsectionβ€Ή
Component of a composition of a β€ΉHomβ€Ί-natural transformation 
with a natural transformation is an arrow in the category β€ΉSetβ€Ί
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_lcomp_Hom_component Ο† a b :
    Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) b ↦cat_Set Ξ± Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) b"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms have a: "a ∈∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "ntcf_lcomp_Hom_component Ο† a b :
      Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) (cf_id ℭ⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ± 
      Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (cf_id ℭ⦇ObjMapβ¦ˆβ¦‡b⦈)"
    unfolding ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod
    by (intro cat_ntcf_Hom_component_is_arr)
      (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
  from this assms(1,3) a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed

lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr':
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
    and "𝔄' = Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) b"
    and "𝔅' = Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) b"
    and "β„­' = cat_Set Ξ±"
  shows "ntcf_lcomp_Hom_component Ο† a b : 𝔄' ↦ℭ' 𝔅'"
  using assms(1-3) 
  unfolding assms(4-6) 
  by (rule cat_ntcf_lcomp_Hom_component_is_arr)

lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_component_is_arr'

lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr:
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat ℭ⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "ntcf_rcomp_Hom_component ψ a b :
    Hom β„­ a (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ± Hom β„­ a (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  from assms have a: "a ∈∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "ntcf_rcomp_Hom_component ψ a b :
      Hom β„­ (cf_id ℭ⦇ObjMapβ¦ˆβ¦‡a⦈) (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ±
      Hom β„­ (cf_id ℭ⦇ObjMapβ¦ˆβ¦‡a⦈) (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
    unfolding ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (intro cat_ntcf_Hom_component_is_arr)
      (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  from this assms(1,3) a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed

lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr':
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat ℭ⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "𝔄' = Hom β„­ a (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
    and "𝔅' = Hom β„­ a (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
    and "β„­' = cat_Set Ξ±"
  shows "ntcf_rcomp_Hom_component ψ a b : 𝔄' ↦ℭ' 𝔅'"
  using assms(1-3) 
  unfolding assms(4-6)
  by (rule cat_ntcf_rcomp_Hom_component_is_arr)

lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_component_is_arr'



subsectionβ€Ή
Composition of a β€ΉHomβ€Ί-natural transformation with two natural transformations
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee subsection 1.15 in \cite{bodo_categories_1970}.β€Ί

definition ntcf_Hom :: "V β‡’ V β‡’ V β‡’ V" (β€ΉHomA.CΔ±'(/_-,_-/')β€Ί)
  where "HomA.CΞ±(Ο†-,ψ-) =
    [
      (
        Ξ»ab∈∘(op_cat (φ⦇NTDGDom⦈) Γ—C Οˆβ¦‡NTDGDom⦈)⦇Obj⦈.
          ntcf_Hom_component Ο† ψ (vpfst ab) (vpsnd ab)
      ),
      HomO.CΞ±Οˆβ¦‡NTDGCod⦈(φ⦇NTCod⦈-,Οˆβ¦‡NTDom⦈-),
      HomO.CΞ±Οˆβ¦‡NTDGCod⦈(φ⦇NTDom⦈-,Οˆβ¦‡NTCod⦈-),
      op_cat (φ⦇NTDGDom⦈) Γ—C Οˆβ¦‡NTDGDom⦈,
      cat_Set Ξ±
    ]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_Hom_components:
  shows "HomA.CΞ±(Ο†-,ψ-)⦇NTMap⦈ =
    (
      Ξ»ab∈∘(op_cat (φ⦇NTDGDom⦈) Γ—C Οˆβ¦‡NTDGDom⦈)⦇Obj⦈.
        ntcf_Hom_component Ο† ψ (vpfst ab) (vpsnd ab)
    )"
    and "HomA.CΞ±(Ο†-,ψ-)⦇NTDom⦈ =
      HomO.CΞ±Οˆβ¦‡NTDGCod⦈(φ⦇NTCod⦈-,Οˆβ¦‡NTDom⦈-)"
    and "HomA.CΞ±(Ο†-,ψ-)⦇NTCod⦈ =
      HomO.CΞ±Οˆβ¦‡NTDGCod⦈(φ⦇NTDom⦈-,Οˆβ¦‡NTCod⦈-)"
    and "HomA.CΞ±(Ο†-,ψ-)⦇NTDGDom⦈ = op_cat (φ⦇NTDGDom⦈) Γ—C Οˆβ¦‡NTDGDom⦈"
    and "HomA.CΞ±(Ο†-,ψ-)⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding ntcf_Hom_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda ntcf_Hom_components(1)
  |vsv ntcf_Hom_NTMap_vsv|

context
  fixes Ξ± Ο† ψ 𝔉 π”Š 𝔉' π”Š' 𝔄 𝔅 β„­
  assumes Ο†: "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and ψ: "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
begin

interpretation Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule Ο†)
interpretation ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule ψ)

mk_VLambda ntcf_Hom_components(1)[of _ Ο† ψ, simplified]
  |vdomain ntcf_Hom_NTMap_vdomain[unfolded in_Hom_iff]|

lemmas [cat_cs_simps] = ntcf_Hom_NTMap_vdomain

lemma ntcf_Hom_NTMap_app[cat_cs_simps]:
  assumes "[a, b]∘ ∈∘ (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
  shows "HomA.CΞ±(Ο†-,ψ-)⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = ntcf_Hom_component Ο† ψ a b"
  using assms
  unfolding ntcf_Hom_components
  by (simp add: nat_omega_simps cat_cs_simps)

end

lemma (in category) ntcf_Hom_NTMap_vrange: 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomA.CΞ±(Ο†-,ψ-)⦇NTMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule assms(2))
  show ?thesis
  proof
    (
      rule vsv.vsv_vrange_vsubset, 
      unfold ntcf_Hom_NTMap_vdomain[OF assms] cat_cs_simps
    )
    fix ab assume "ab ∈∘ (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" 
        and a: "a ∈∘ op_cat 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈"
      by 
        (
          rule cat_prod_2_ObjE[
            OF Ο†.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
            ]
        )
    from assms a b category_cat_Set category_axioms show 
      "HomA.CΞ±(Ο†-,ψ-)⦇NTMapβ¦ˆβ¦‡ab⦈ ∈∘ cat_Set α⦇Arr⦈"
      unfolding ab_def cat_op_simps
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (simp add: ntcf_Hom_NTMap_vsv)
qed


subsubsectionβ€Ή
Composition of a β€ΉHomβ€Ί-natural transformation with 
two natural transformations is a natural transformation
β€Ί

lemma (in category) cat_ntcf_Hom_is_ntcf: 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
  shows "HomA.CΞ±(Ο†-,ψ-) :
    HomO.CΞ±β„­(π”Š-,𝔉'-) ↦CF HomO.CΞ±β„­(𝔉-,π”Š'-) :
    op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
proof-

  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule assms(2))

  show ?thesis
  proof(intro is_ntcfI')
    show "vfsequence (HomA.CΞ±(Ο†-,ψ-))" unfolding ntcf_Hom_def by simp
    show "vcard (HomA.CΞ±(Ο†-,ψ-)) = 5β„•"
      unfolding ntcf_Hom_def by (simp add: nat_omega_simps)
    from assms category_axioms show 
      "HomO.CΞ±β„­(π”Š-,𝔉'-) : op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms category_axioms show 
      "HomO.CΞ±β„­(𝔉-,π”Š'-) : op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "π’Ÿβˆ˜ (HomA.CΞ±(Ο†-,ψ-)⦇NTMap⦈) = (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "HomA.CΞ±(Ο†-,ψ-)⦇NTMapβ¦ˆβ¦‡ab⦈ :
      HomO.CΞ±β„­(π”Š-,𝔉'-)⦇ObjMapβ¦ˆβ¦‡ab⦈ ↦cat_Set Ξ±
      HomO.CΞ±β„­(𝔉-,π”Š'-)⦇ObjMapβ¦ˆβ¦‡ab⦈"
      if "ab ∈∘ (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈" for ab 
    proof-
      from that obtain a b
        where ab_def: "ab = [a, b]∘" 
          and a: "a ∈∘ op_cat 𝔄⦇Obj⦈" 
          and b: "b ∈∘ 𝔅⦇Obj⦈"
        by 
          (
            rule cat_prod_2_ObjE[
              OF Ο†.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
              ]
          )
      from category_axioms assms a b show 
        "HomA.CΞ±(Ο†-,ψ-)⦇NTMapβ¦ˆβ¦‡ab⦈ :
          HomO.CΞ±β„­(π”Š-,𝔉'-)⦇ObjMapβ¦ˆβ¦‡ab⦈ ↦cat_Set Ξ±
          HomO.CΞ±β„­(𝔉-,π”Š'-)⦇ObjMapβ¦ˆβ¦‡ab⦈"
        unfolding ab_def cat_op_simps
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed
    show 
      "HomA.CΞ±(Ο†-,ψ-)⦇NTMapβ¦ˆβ¦‡a'b'⦈ ∘Acat_Set Ξ±
       HomO.CΞ±β„­(π”Š-,𝔉'-)⦇ArrMapβ¦ˆβ¦‡gf⦈ =
        HomO.CΞ±β„­(𝔉-,π”Š'-)⦇ArrMapβ¦ˆβ¦‡gf⦈ ∘Acat_Set Ξ±
        HomA.CΞ±(Ο†-,ψ-)⦇NTMapβ¦ˆβ¦‡ab⦈"
      if "gf : ab ↦op_cat 𝔄 Γ—C 𝔅 a'b'" for ab a'b' gf
    proof-
      from that obtain g f a b a' b'
        where gf_def: "gf = [g, f]∘" 
          and ab_def: "ab = [a, b]∘" 
          and a'b'_def: "a'b' = [a', b']∘"
          and g: "g : a ↦op_cat 𝔄 a'"
          and f: "f : b ↦𝔅 b'" 
        by 
          (
            elim 
              cat_prod_2_is_arrE[
                OF Ο†.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
                ]
          )
      from assms category_axioms that g f show ?thesis
        unfolding gf_def ab_def a'b'_def cat_op_simps
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_ntcf_Hom_component_nat cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed
  qed (auto simp: ntcf_Hom_components cat_cs_simps)

qed

lemma (in category) cat_ntcf_Hom_is_ntcf': 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
    and "Ξ² = Ξ±"
    and "𝔄' = HomO.CΞ±β„­(π”Š-,𝔉'-)"
    and "𝔅' = HomO.CΞ±β„­(𝔉-,π”Š'-)"
    and "β„­' = op_cat 𝔄 Γ—C 𝔅"
    and "𝔇' = cat_Set Ξ±"
  shows "HomA.CΞ±(Ο†-,ψ-) : 𝔄' ↦CF 𝔅' : β„­' ↦↦CΞ² 𝔇'"
  using assms(1-2) unfolding assms(3-7) by (rule cat_ntcf_Hom_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_Hom_is_ntcf'


subsubsectionβ€Ή
Composition of a β€ΉHomβ€Ί-natural transformation with 
two vertical compositions of natural transformations
β€Ί

lemma (in category) cat_ntcf_Hom_vcomp:
  assumes "Ο†' : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± β„­" 
    and "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "ψ' : π”Š' ↦CF β„Œ' : 𝔅 ↦↦CΞ± β„­" 
    and "ψ : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ± β„­"
  shows 
    "HomA.CΞ±(Ο†' βˆ™NTCF Ο†-,ψ' βˆ™NTCF ψ-) =
      HomA.CΞ±(Ο†-,ψ'-) βˆ™NTCF HomA.CΞ±(Ο†'-,ψ-)"
proof(rule ntcf_eqI[of Ξ±])

  interpret Ο†': is_ntcf Ξ± 𝔄 β„­ π”Š β„Œ Ο†' by (rule assms(1))
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(2))
  interpret ψ': is_ntcf Ξ± 𝔅 β„­ π”Š' β„Œ' ψ' by (rule assms(3))
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉' π”Š' ψ by (rule assms(4))

  from category_axioms assms show H_vcomp:
    "HomA.CΞ±(Ο†' βˆ™NTCF Ο†-,ψ' βˆ™NTCF ψ-) :
      HomO.CΞ±β„­(β„Œ-,𝔉'-) ↦CF HomO.CΞ±β„­(𝔉-,β„Œ'-) :
      op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show vcomp_H:
    "HomA.CΞ±(Ο†-,ψ'-) βˆ™NTCF HomA.CΞ±(Ο†'-,ψ-) :
      HomO.CΞ±β„­(β„Œ-,𝔉'-) ↦CF HomO.CΞ±β„­(𝔉-,β„Œ'-) :
      op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms H_vcomp have dom_H_vcomp:
    "π’Ÿβˆ˜ (HomA.CΞ±(Ο†' βˆ™NTCF Ο†-,ψ' βˆ™NTCF ψ-)⦇NTMap⦈) = (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms H_vcomp have dom_vcomp_H:
    "π’Ÿβˆ˜ ((HomA.CΞ±(Ο†-,ψ'-) βˆ™NTCF HomA.CΞ±(Ο†'-,ψ-))⦇NTMap⦈) =
      (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show "HomA.CΞ±(Ο†' βˆ™NTCF Ο†-,ψ' βˆ™NTCF ψ-)⦇NTMap⦈ =
    (HomA.CΞ±(Ο†-,ψ'-) βˆ™NTCF HomA.CΞ±(Ο†'-,ψ-))⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_H_vcomp dom_vcomp_H)
    fix ab assume prems: "ab ∈∘ (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" 
        and a: "a ∈∘ 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈"
      by 
        ( 
          auto 
            elim: 
              cat_prod_2_ObjE[
                OF Ο†'.NTDom.HomDom.category_op ψ'.NTDom.HomDom.category_axioms
                ]
            simp: cat_op_simps
        )
    from 
      assms a b
      category_axioms 
      Ο†'.NTDom.HomDom.category_axioms
      ψ'.NTDom.HomDom.category_axioms 
    show
      "HomA.CΞ±(Ο†' βˆ™NTCF Ο†-,ψ' βˆ™NTCF ψ-)⦇NTMapβ¦ˆβ¦‡ab⦈ =
        (HomA.CΞ±(Ο†-,ψ'-) βˆ™NTCF HomA.CΞ±(Ο†'-,ψ-))⦇NTMapβ¦ˆβ¦‡ab⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps ab_def
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (auto simp: ntcf_Hom_NTMap_vsv cat_cs_intros)

qed simp_all

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_vcomp

lemma (in category) cat_ntcf_Hom_ntcf_id:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­" and "𝔉': 𝔅 ↦↦CΞ± β„­"
  shows "HomA.CΞ±(ntcf_id 𝔉-,ntcf_id 𝔉'-) = ntcf_id HomO.CΞ±β„­(𝔉-,𝔉'-)"
proof(rule ntcf_eqI[of Ξ±])

  interpret 𝔉: is_functor Ξ± 𝔄 β„­ 𝔉 by (rule assms(1))
  interpret 𝔉': is_functor Ξ± 𝔅 β„­ 𝔉' by (rule assms(2))

  from category_axioms assms show H_id:
    "HomA.CΞ±(ntcf_id 𝔉-,ntcf_id 𝔉'-) :
      HomO.CΞ±β„­(𝔉-,𝔉'-) ↦CF HomO.CΞ±β„­(𝔉-,𝔉'-) :
      op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show id_H:
    "ntcf_id HomO.CΞ±β„­(𝔉-,𝔉'-) :
      HomO.CΞ±β„­(𝔉-,𝔉'-) ↦CF HomO.CΞ±β„­(𝔉-,𝔉'-) :
      op_cat 𝔄 Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  from category_axioms assms H_id have dom_H_id:
    "π’Ÿβˆ˜ (HomA.CΞ±(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈) = (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms H_id have dom_id_H:
    "π’Ÿβˆ˜ (ntcf_id HomO.CΞ±β„­(𝔉-,𝔉'-)⦇NTMap⦈) = (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show 
    "HomA.CΞ±(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈ =
      ntcf_id HomO.CΞ±β„­(𝔉-,𝔉'-)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_H_id dom_id_H)
    show "vsv (HomA.CΞ±(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈)" 
      by (rule ntcf_Hom_NTMap_vsv)
    from id_H show "vsv (ntcf_id HomO.CΞ±β„­(𝔉-,𝔉'-)⦇NTMap⦈)"
      by (intro is_functor.ntcf_id_NTMap_vsv) 
        (cs_concl cs_simp: cs_intro: cat_cs_intros)
    fix ab assume "ab ∈∘ (op_cat 𝔄 Γ—C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" 
        and a: "a ∈∘ 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈"
      by 
        ( 
          auto 
            elim: 
              cat_prod_2_ObjE[OF 𝔉.HomDom.category_op 𝔉'.HomDom.category_axioms]
            simp: cat_op_simps
        )
    from category_axioms assms a b H_id id_H show
      "HomA.CΞ±(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMapβ¦ˆβ¦‡ab⦈ = 
        ntcf_id HomO.CΞ±β„­(𝔉-,𝔉'-)⦇NTMapβ¦ˆβ¦‡ab⦈"
      unfolding ab_def
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed simp

qed simp_all

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_ntcf_id



subsectionβ€Ή
Composition of a β€ΉHomβ€Ί-natural transformation with a natural transformation
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee subsection 1.15 in \cite{bodo_categories_1970}.β€Ί

definition ntcf_lcomp_Hom :: "V β‡’ V β‡’ V" (β€ΉHomA.CΔ±'(/_-,-/')β€Ί)
  where "HomA.CΞ±(Ο†-,-) = HomA.CΞ±(Ο†-,ntcf_id (cf_id (φ⦇NTDGCod⦈))-)"

definition ntcf_rcomp_Hom :: "V β‡’ V β‡’ V" (β€ΉHomA.CΔ±'(/-,_-/')β€Ί)
  where "HomA.CΞ±(-,ψ-) = HomA.CΞ±(ntcf_id (cf_id (Οˆβ¦‡NTDGCod⦈))-,ψ-)"


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma ntcf_lcomp_Hom_NTMap_vsv: "vsv (HomA.CΞ±(Ο†-,-)⦇NTMap⦈)"
  unfolding ntcf_lcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)

lemma ntcf_rcomp_Hom_NTMap_vsv: "vsv (HomA.CΞ±(-,ψ-)⦇NTMap⦈)"
  unfolding ntcf_rcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)

lemma ntcf_lcomp_Hom_NTMap_vdomain[cat_cs_simps]:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" 
  shows "π’Ÿβˆ˜ (HomA.CΞ±(Ο†-,-)⦇NTMap⦈) = (op_cat 𝔄 Γ—C β„­)⦇Obj⦈"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_def Ο†.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_NTMap_vdomain[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" 
  shows "π’Ÿβˆ˜ (HomA.CΞ±(-,ψ-)⦇NTMap⦈) = (op_cat β„­ Γ—C 𝔅)⦇Obj⦈"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_rcomp_Hom_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_NTMap_app[cat_cs_simps]:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
  shows "HomA.CΞ±(Ο†-,-)⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = ntcf_lcomp_Hom_component Ο† a b"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  show ?thesis
    unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod
    using assms unfolding cat_op_simps
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_op_simps
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed

lemma ntcf_rcomp_Hom_NTMap_app[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "a ∈∘ op_cat ℭ⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomA.CΞ±(-,ψ-)⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ = ntcf_rcomp_Hom_component ψ a b"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  show ?thesis
    unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    using assms unfolding cat_op_simps
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed

lemma (in category) ntcf_lcomp_Hom_NTMap_vrange:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomA.CΞ±(Ο†-,-)⦇NTMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def Ο†.ntcf_NTDGCod
    by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed

lemma (in category) ntcf_rcomp_Hom_NTMap_vrange:
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (HomA.CΞ±(-,ψ-)⦇NTMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed


subsubsectionβ€Ή
Composition of a β€ΉHomβ€Ί-natural transformation with 
a natural transformation is a natural transformation
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf: 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" 
  shows "HomA.CΞ±(Ο†-,-) :
    HomO.CΞ±β„­(π”Š-,-) ↦CF HomO.CΞ±β„­(𝔉-,-) : op_cat 𝔄 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms category_axioms show ?thesis
    unfolding 
      ntcf_lcomp_Hom_def cf_bcomp_Hom_cf_lcomp_Hom[symmetric] Ο†.ntcf_NTDGCod
    by (intro category.cat_ntcf_Hom_is_ntcf)
      (cs_concl cs_intro: cat_cs_intros)+
qed

lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf': 
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­" 
    and "Ξ² = Ξ±"
    and "𝔄' = HomO.CΞ±β„­(π”Š-,-)"
    and "𝔅' = HomO.CΞ±β„­(𝔉-,-)"
    and "β„­' = op_cat 𝔄 Γ—C β„­"
    and "𝔇' = cat_Set Ξ±"
  shows "HomA.CΞ±(Ο†-,-) : 𝔄' ↦CF 𝔅' : β„­' ↦↦CΞ² 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_lcomp_Hom_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_is_ntcf'

lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf:
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" 
  shows "HomA.Cα(-,ψ-) :
    HomO.CΞ±β„­(-,𝔉-) ↦CF HomO.CΞ±β„­(-,π”Š-) : op_cat β„­ Γ—C 𝔅 ↦↦CΞ± cat_Set Ξ±"
proof-
  interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule assms(1))
  from assms category_axioms show ?thesis
    unfolding 
      ntcf_rcomp_Hom_def cf_bcomp_Hom_cf_rcomp_Hom[symmetric] ψ.ntcf_NTDGCod
    by (intro category.cat_ntcf_Hom_is_ntcf)
      (cs_concl cs_intro: cat_cs_intros)+
qed

lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf':
  assumes "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "Ξ² = Ξ±"
    and "𝔄' = HomO.CΞ±β„­(-,𝔉-)"
    and "𝔅' = HomO.CΞ±β„­(-,π”Š-)"
    and "β„­' = op_cat β„­ Γ—C 𝔅"  
    and "𝔇' = cat_Set Ξ±"
  shows "HomA.CΞ±(-,ψ-) : 𝔄' ↦CF 𝔅' : β„­' ↦↦CΞ± 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_rcomp_Hom_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_is_ntcf'


subsubsectionβ€Ή
Component of a composition of a β€ΉHomβ€Ί-natural transformation 
with a natural transformation and the Yoneda component
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_component_is_Yoneda_component:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "b ∈∘ op_cat 𝔅⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows 
    "ntcf_lcomp_Hom_component Ο† b c =
      Yoneda_component HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) (φ⦇NTMapβ¦ˆβ¦‡b⦈) c"
  (is β€Ή?lcomp = ?Ycβ€Ί)
proof-

  interpret Ο†: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š Ο† by (rule assms(1))

  from assms(2) have b: "b ∈∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by clarsimp
  from b have 𝔉b: "𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈" and π”Šb: "π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈"
    by (auto intro: cat_cs_intros)
  from assms(1,3) b category_axioms have Ο†b:
    "φ⦇NTMapβ¦ˆβ¦‡b⦈ ∈∘ HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)⦇ObjMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

  have lcomp:
    "?lcomp : Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) c ↦cat_Set Ξ± Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) c"
    by (rule cat_ntcf_lcomp_Hom_component_is_arr[OF assms])
  then have dom_lhs: "π’Ÿβˆ˜ (?lcomp⦇ArrVal⦈) = Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) c"
    by (cs_concl cs_simp: cat_cs_simps)  

  have Yc: "?Yc :
    Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) c ↦cat_Set Ξ± HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-)⦇ObjMapβ¦ˆβ¦‡c⦈"
    by 
      (
        rule cat_Yoneda_component_is_arr[
          OF cat_cf_Hom_snd_is_functor[OF 𝔉b] π”Šb Ο†b assms(3)
          ]
      )
  then have dom_rhs: "π’Ÿβˆ˜ (?Yc⦇ArrVal⦈) = Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) c"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
  
    from lcomp show "arr_Set Ξ± ?lcomp" by (auto dest: cat_Set_is_arrD(1))
    from Yc show "arr_Set Ξ± ?Yc" by (auto dest: cat_Set_is_arrD(1))
  
    show "?lcomp⦇ArrVal⦈ = ?Yc⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      from assms(1) b category_axioms show "vsv (?Yc⦇ArrVal⦈)"
        by (intro is_functor.Yoneda_component_ArrVal_vsv)
          (cs_concl cs_intro: cat_cs_intros)
      show "?lcomp⦇ArrValβ¦ˆβ¦‡f⦈ = ?Yc⦇ArrValβ¦ˆβ¦‡f⦈"
        if "f ∈∘ Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) c" for f
      proof-
        from that have "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈ ↦ℭ c" by simp
        with category_axioms assms(1,3) b show ?thesis
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_op_simps 
                cs_intro: cat_cs_intros cat_op_intros
            )
      qed
    qed (simp_all add: ntcf_lcomp_Hom_component_ArrVal_vsv)
    
    from Yc category_axioms assms(1,3) b have
      "?Yc : Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈) c ↦cat_Set Ξ± Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) c"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros) 
    with lcomp show "?lcomp⦇ArrCod⦈ = ?Yc⦇ArrCod⦈"
      by (cs_concl cs_simp: cat_cs_simps)
  
  qed (use lcomp Yc in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)

qed


subsubsectionβ€Ή
Composition of a β€ΉHomβ€Ί-natural transformation with 
a vertical composition of natural transformations
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_vcomp:
  assumes "Ο†' : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± β„­" and "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
  shows "HomA.CΞ±(Ο†' βˆ™NTCF Ο†-,-) = HomA.CΞ±(Ο†-,-) βˆ™NTCF HomA.CΞ±(Ο†'-,-)"
proof-
  interpret Ο†': is_ntcf Ξ± 𝔄 β„­ π”Š β„Œ Ο†' by (rule assms(1))
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(2))
  from category_axioms have ntcf_id_cf_id:
    "ntcf_id (cf_id β„­) = ntcf_id (cf_id β„­) βˆ™NTCF ntcf_id (cf_id β„­)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show ?thesis
    unfolding 
      ntcf_lcomp_Hom_def
      ntsmcf_vcomp_components 
      dghm_id_components 
      Ο†'.ntcf_NTDGCod
      Ο†.ntcf_NTDGCod
    by (subst ntcf_id_cf_id) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_vcomp

lemma (in category) cat_ntcf_rcomp_Hom_vcomp:
  assumes "Ο†' : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± β„­" and "Ο† : 𝔉 ↦CF π”Š : 𝔄 ↦↦CΞ± β„­"
  shows "HomA.CΞ±(-,Ο†' βˆ™NTCF Ο†-) = HomA.CΞ±(-,Ο†'-) βˆ™NTCF HomA.CΞ±(-,Ο†-)"
proof-
  interpret Ο†': is_ntcf Ξ± 𝔄 β„­ π”Š β„Œ Ο†' by (rule assms(1))
  interpret Ο†: is_ntcf Ξ± 𝔄 β„­ 𝔉 π”Š Ο† by (rule assms(2))
  from category_axioms have ntcf_id_cf_id:
    "ntcf_id (cf_id β„­) = ntcf_id (cf_id β„­) βˆ™NTCF ntcf_id (cf_id β„­)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show ?thesis
    unfolding 
      ntcf_rcomp_Hom_def
      ntsmcf_vcomp_components 
      dghm_id_components 
      Ο†'.ntcf_NTDGCod
      Ο†.ntcf_NTDGCod
    by (subst ntcf_id_cf_id) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_vcomp


subsubsectionβ€Ή
Composition of a β€ΉHomβ€Ί-natural transformation with an identity natural 
transformation
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_ntcf_id:
  assumes "𝔉 : 𝔄 ↦↦CΞ± β„­"
  shows "HomA.CΞ±(ntcf_id 𝔉-,-) = ntcf_id HomO.CΞ±β„­(𝔉-,-)"
proof-
  interpret 𝔉: is_functor Ξ± 𝔄 β„­ 𝔉 by (rule assms(1))
  from category_axioms assms show ?thesis
    unfolding ntcf_lcomp_Hom_def ntcf_id_components 𝔉.cf_HomCod
    by
      (
        cs_concl
          cs_simp: ntcf_lcomp_Hom_def cat_cs_simps 
          cs_intro: cat_cs_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_id

lemma (in category) cat_ntcf_rcomp_Hom_ntcf_id:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
  shows "HomA.CΞ±(-,ntcf_id 𝔉-) = ntcf_id HomO.CΞ±β„­(-,𝔉-)"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  from category_axioms assms show ?thesis
    unfolding ntcf_rcomp_Hom_def ntcf_id_components 𝔉.cf_HomCod
    by (cs_concl cs_simp: ntcf_rcomp_Hom_def cat_cs_simps cs_intro: cat_cs_intros)
qed

lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_ntcf_id



subsectionβ€ΉProjections of a β€ΉHomβ€Ί-natural transformationβ€Ί


textβ€Ή
The concept of a projection of a β€ΉHomβ€Ί-natural transformation appears 
in the corollary to the Yoneda Lemma in Chapter III-2 in 
\cite{mac_lane_categories_2010} (although the concept has not been given
any specific name in the aforementioned reference).
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition ntcf_Hom_snd :: "V β‡’ V β‡’ V β‡’ V" (β€ΉHomA.CΔ±_'(/_,-/')β€Ί)
  where "HomA.CΞ±β„­(f,-) =
    Yoneda_arrow Ξ± (HomO.CΞ±β„­(ℭ⦇Domβ¦ˆβ¦‡f⦈,-)) (ℭ⦇Codβ¦ˆβ¦‡f⦈) f"

definition ntcf_Hom_fst :: "V β‡’ V β‡’ V β‡’ V" (β€ΉHomA.CΔ±_'(/-,_/')β€Ί)
  where "HomA.CΞ±β„­(-,f) = HomA.CΞ±op_cat β„­(f,-)"


textβ€ΉComponents.β€Ί

lemma (in category) cat_ntcf_Hom_snd_components:
  assumes "f : s ↦ℭ r"
  shows "HomA.CΞ±β„­(f,-)⦇NTMap⦈ = 
    (Ξ»dβˆˆβˆ˜β„­β¦‡Obj⦈. Yoneda_component HomO.CΞ±β„­(s,-) r f d)"
    and "HomA.CΞ±β„­(f,-)⦇NTDom⦈ = HomO.CΞ±β„­(r,-)"
    and "HomA.CΞ±β„­(f,-)⦇NTCod⦈ = HomO.CΞ±β„­(s,-)"
    and "HomA.CΞ±β„­(f,-)⦇NTDGDom⦈ = β„­"
    and "HomA.CΞ±β„­(f,-)⦇NTDGCod⦈ = cat_Set Ξ±"
proof-
  interpret is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(s,-)β€Ί
    using assms category_axioms by (cs_concl cs_simp: cs_intro: cat_cs_intros)
  show "HomA.CΞ±β„­(f,-)⦇NTMap⦈ =
    (Ξ»dβˆˆβˆ˜β„­β¦‡Obj⦈. Yoneda_component HomO.CΞ±β„­(s,-) r f d)"
    and "HomA.CΞ±β„­(f,-)⦇NTDom⦈ = HomO.CΞ±β„­(r,-)"
    and "HomA.CΞ±β„­(f,-)⦇NTCod⦈ = HomO.CΞ±β„­(s,-)"
    and "HomA.CΞ±β„­(f,-)⦇NTDGDom⦈ = β„­"
    and "HomA.CΞ±β„­(f,-)⦇NTDGCod⦈ = cat_Set Ξ±"
    unfolding ntcf_Hom_snd_def cat_is_arrD[OF assms] Yoneda_arrow_components
    by simp_all
qed

lemma (in category) cat_ntcf_Hom_fst_components:
  assumes "f : r ↦ℭ s"
  shows "HomA.CΞ±β„­(-,f)⦇NTMap⦈ =
    (Ξ»d∈∘op_cat ℭ⦇Obj⦈. Yoneda_component HomO.CΞ±β„­(-,s) r f d)"
    and "HomA.CΞ±β„­(-,f)⦇NTDom⦈ = HomO.CΞ±β„­(-,r)"
    and "HomA.CΞ±β„­(-,f)⦇NTCod⦈ = HomO.CΞ±β„­(-,s)"
    and "HomA.CΞ±β„­(-,f)⦇NTDGDom⦈ = op_cat β„­"
    and "HomA.CΞ±β„­(-,f)⦇NTDGCod⦈ = cat_Set Ξ±"
  using category_axioms assms
  unfolding 
    ntcf_Hom_fst_def
    category.cat_ntcf_Hom_snd_components[
      OF category_op, unfolded cat_op_simps, OF assms
      ]
    cat_op_simps
  by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+


textβ€ΉAlternative definition.β€Ί

lemma (in category) ntcf_Hom_snd_def':
  assumes "f : r ↦ℭ s"
  shows "HomA.CΞ±β„­(f,-) = Yoneda_arrow Ξ± (HomO.CΞ±β„­(r,-)) s f"
  using assms unfolding ntcf_Hom_snd_def by (simp add: cat_cs_simps) 

lemma (in category) ntcf_Hom_fst_def':
  assumes "f : r ↦ℭ s"
  shows "HomA.CΞ±β„­(-,f) = Yoneda_arrow Ξ± HomO.CΞ±β„­(-,s) r f"
proof-
  from assms category_axioms show ?thesis
    unfolding ntcf_Hom_fst_def ntcf_Hom_snd_def cat_op_simps
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed


subsubsectionβ€ΉNatural transformation mapβ€Ί

context category
begin

context
  fixes s r f
  assumes f: "f : s ↦ℭ r"
begin

mk_VLambda cat_ntcf_Hom_snd_components(1)[OF f]
  |vsv ntcf_Hom_snd_NTMap_vsv[intro]|
  |vdomain ntcf_Hom_snd_NTMap_vdomain|
  |app ntcf_Hom_snd_NTMap_app|

end

context
  fixes s r f
  assumes f: "f : r ↦ℭ s"
begin

mk_VLambda cat_ntcf_Hom_fst_components(1)[OF f]
  |vsv ntcf_Hom_fst_NTMap_vsv[intro]|
  |vdomain ntcf_Hom_fst_NTMap_vdomain|
  |app ntcf_Hom_fst_NTMap_app|

end

end

lemmas [cat_cs_simps] = 
  category.ntcf_Hom_snd_NTMap_vdomain
  category.ntcf_Hom_fst_NTMap_vdomain

lemmas ntcf_Hom_snd_NTMap_app[cat_cs_simps] = 
  category.ntcf_Hom_snd_NTMap_app
  category.ntcf_Hom_fst_NTMap_app


subsubsectionβ€Ή
β€ΉHomβ€Ί-natural transformation projections are natural transformations
β€Ί

lemma (in category) cat_ntcf_Hom_snd_is_ntcf:
  assumes "f : s ↦ℭ r"
  shows "HomA.CΞ±β„­(f,-) :
    HomO.CΞ±β„­(r,-) ↦CF HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  note f = cat_is_arrD[OF assms]
  show ?thesis
    unfolding ntcf_Hom_snd_def f
  proof(rule category.cat_Yoneda_arrow_is_ntcf)
    from assms category_axioms show "f ∈∘ HomO.CΞ±β„­(s,-)⦇ObjMapβ¦ˆβ¦‡r⦈"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  qed (intro category_axioms cat_cf_Hom_snd_is_functor f)+
qed

lemma (in category) cat_ntcf_Hom_snd_is_ntcf':
  assumes "f : s ↦ℭ r"
    and "Ξ² = Ξ±"
    and "𝔄' = HomO.CΞ±β„­(r,-)"
    and "𝔅' = HomO.CΞ±β„­(s,-)"
    and "β„­' = β„­"
    and "𝔇' = cat_Set Ξ±"
  shows "HomA.CΞ±β„­(f,-) : 𝔄' ↦CF 𝔅' : β„­' ↦↦CΞ² 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_snd_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_Hom_snd_is_ntcf'

lemma (in category) cat_ntcf_Hom_fst_is_ntcf:
  assumes "f : r ↦ℭ s"
  shows "HomA.CΞ±β„­(-,f) :
    HomO.CΞ±β„­(-,r) ↦CF HomO.CΞ±β„­(-,s) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  from assms have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  from 
    category.cat_ntcf_Hom_snd_is_ntcf[
      OF category_op, 
      unfolded cat_op_simps, 
      OF assms, 
      unfolded cat_op_cat_cf_Hom_snd[OF r] cat_op_cat_cf_Hom_snd[OF s],
      folded ntcf_Hom_fst_def
      ]
  show ?thesis .
qed

lemma (in category) cat_ntcf_Hom_fst_is_ntcf':
  assumes "f : r ↦ℭ s"
    and "Ξ² = Ξ±"
    and "𝔄' = HomO.CΞ±β„­(-,r)"
    and "𝔅' = HomO.CΞ±β„­(-,s)"
    and "β„­' = op_cat β„­"
    and "𝔇' = cat_Set Ξ±"
  shows "HomA.CΞ±β„­(-,f) : 𝔄' ↦CF 𝔅' : β„­' ↦↦CΞ² 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_fst_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_Hom_fst_is_ntcf'


subsubsectionβ€ΉOpposite β€ΉHomβ€Ί-natural transformation projectionsβ€Ί

lemma (in category) cat_op_cat_ntcf_Hom_snd: 
  "HomA.CΞ±op_cat β„­(f,-) = HomA.CΞ±β„­(-,f)"
  unfolding ntcf_Hom_fst_def by simp

lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_snd

lemma (in category) cat_op_cat_ntcf_Hom_fst:
  "HomA.CΞ±op_cat β„­(-,f) = HomA.CΞ±β„­(f,-)"
  unfolding ntcf_Hom_fst_def cat_op_simps by simp

lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_fst


subsubsectionβ€Ή
β€ΉHomβ€Ί-natural transformation projections and the Yoneda component
β€Ί

lemma (in category) cat_Yoneda_component_cf_Hom_snd_Comp:
  assumes "g : b ↦ℭ c" and "f : a ↦ℭ b" and "d ∈∘ ℭ⦇Obj⦈"
  shows 
    "Yoneda_component HomO.CΞ±β„­(a,-) b f d ∘Acat_Set Ξ±
      Yoneda_component HomO.CΞ±β„­(b,-) c g d =
      Yoneda_component HomO.CΞ±β„­(a,-) c (g ∘Aβ„­ f) d"
    (is β€Ή?Ya b f d ∘Acat_Set Ξ± ?Yb c g d = ?Ya c (g ∘Aβ„­ f) dβ€Ί)
proof-

  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)

  note gD = cat_is_arrD[OF assms(1)]
  note fD = cat_is_arrD[OF assms(2)]

  from assms category_axioms have Y_f:
    "?Ya b f d : Hom β„­ b d ↦cat_Set Ξ± Hom β„­ a d"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  moreover from assms category_axioms have Y_g: 
    "?Yb c g d : Hom β„­ c d ↦cat_Set Ξ± Hom β„­ b d"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  ultimately have Yf_Yg: 
    "?Ya b f d ∘Acat_Set Ξ± ?Yb c g d : Hom β„­ c d ↦cat_Set Ξ± Hom β„­ a d"
    by (auto intro: cat_cs_intros)
  from assms category_axioms have Y_gf: 
    "?Ya c (g ∘Aβ„­ f) d : Hom β„­ c d ↦cat_Set Ξ± Hom β„­ a d"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  from Yf_Yg have dom_rhs: 
    "π’Ÿβˆ˜ ((?Ya b f d ∘Acat_Set Ξ± ?Yb c g d)⦇ArrVal⦈) = Hom β„­ c d"
    by (cs_concl cs_simp: cat_cs_simps)
  from Y_gf have dom_lhs: "π’Ÿβˆ˜ (?Ya c (g ∘Aβ„­ f) d⦇ArrVal⦈) = Hom β„­ c d"  
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from Yf_Yg show arr_Set_Yf_Yg: 
      "arr_Set α (?Ya b f d ∘Acat_Set α ?Yb c g d)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret Yf_Yg: arr_Set Ξ± β€Ή?Ya b f d ∘Acat_Set Ξ± ?Yb c g dβ€Ί
      by (rule arr_Set_Yf_Yg)
    from Y_gf show arr_Set_Y_gf: "arr_Set Ξ± (?Ya c (g ∘Aβ„­ f) d)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret Yf_Yg: arr_Set Ξ± β€Ή?Ya c (g ∘Aβ„­ f) dβ€Ί by (rule arr_Set_Y_gf)
    show
      "(?Ya b f d ∘Acat_Set Ξ± ?Yb c g d)⦇ArrVal⦈ =
        ?Ya c (g ∘Aβ„­ f) d⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume "h : c ↦ℭ d"
      with Y_gf Y_g Y_f category_axioms assms show 
        "(?Ya b f d ∘Acat_Set Ξ± ?Yb c g d)⦇ArrValβ¦ˆβ¦‡h⦈ =
          ?Ya c (g ∘Aβ„­ f) d⦇ArrValβ¦ˆβ¦‡h⦈"
        (*slow*)
        by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    qed auto
  
  qed (use Y_gf Yf_Yg in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemmas [cat_cs_simps] = 
  category.cat_Yoneda_component_cf_Hom_snd_Comp[symmetric]

lemma (in category) cat_Yoneda_component_cf_Hom_snd_CId:
  assumes "c ∈∘ ℭ⦇Obj⦈" and "d ∈∘ ℭ⦇Obj⦈"
  shows 
    "Yoneda_component HomO.CΞ±β„­(c,-) c (ℭ⦇CIdβ¦ˆβ¦‡c⦈) d = 
      cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c d⦈"
  (is β€Ή?Ycd = cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c dβ¦ˆβ€Ί)
proof-

  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)

  from assms category_axioms have Y_CId_c: 
    "?Ycd : Hom β„­ c d ↦cat_Set Ξ± Hom β„­ c d"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  from Y_CId_c Set.category_axioms assms category_axioms have CId_cd:
    "cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c d⦈ : Hom β„­ c d ↦cat_Set Ξ± Hom β„­ c d"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from Y_CId_c have dom_lhs: "π’Ÿβˆ˜ (?Ycd⦇ArrVal⦈) = Hom β„­ c d"  
    by (cs_concl cs_simp: cat_cs_simps)
  from CId_cd have dom_rhs: "π’Ÿβˆ˜ (cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c dβ¦ˆβ¦‡ArrVal⦈) = Hom β„­ c d"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from Y_CId_c show arr_Set_Y_CId_c: "arr_Set Ξ± ?Ycd"
      by (auto dest: cat_Set_is_arrD(1))
    interpret Yf_Yg: arr_Set Ξ± ?Ycd by (rule arr_Set_Y_CId_c)
    from CId_cd show arr_Set_CId_cd: "arr_Set Ξ± (cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c d⦈)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret CId_cd: arr_Set Ξ± β€Ήcat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c dβ¦ˆβ€Ί
      by (rule arr_Set_CId_cd)
    show "?Ycd⦇ArrVal⦈ = cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c dβ¦ˆβ¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume "h : c ↦ℭ d"
      with CId_cd Y_CId_c category_axioms assms show 
        "?Ycd⦇ArrValβ¦ˆβ¦‡h⦈ = cat_Set α⦇CIdβ¦ˆβ¦‡Hom β„­ c dβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡h⦈"
        by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    qed auto
  qed (use Y_CId_c CId_cd in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemmas [cat_cs_simps] = category.cat_Yoneda_component_cf_Hom_snd_CId


subsubsectionβ€Ήβ€ΉHomβ€Ί-natural transformation projection of a compositionβ€Ί

lemma (in category) cat_ntcf_Hom_snd_Comp:
  assumes "g : b ↦ℭ c" and "f : a ↦ℭ b"
  shows "HomA.CΞ±β„­(g ∘Aβ„­ f,-) = HomA.CΞ±β„­(f,-) βˆ™NTCF HomA.CΞ±β„­(g,-)"
  (is β€Ή?H_gf = ?H_f βˆ™NTCF ?H_gβ€Ί)
proof(rule ntcf_eqI[of Ξ±])
  from assms category_axioms show 
    "?H_gf : HomO.CΞ±β„­(c,-) ↦CF HomO.CΞ±β„­(a,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms show "?H_f βˆ™NTCF ?H_g :
    HomO.CΞ±β„­(c,-) ↦CF HomO.CΞ±β„­(a,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have lhs_dom: "π’Ÿβˆ˜ (?H_gf⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have rhs_dom:
    "π’Ÿβˆ˜ ((?H_f βˆ™NTCF ?H_g)⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "?H_gf⦇NTMap⦈ = (?H_f βˆ™NTCF ?H_g)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
    fix d assume "d ∈∘ ℭ⦇Obj⦈" 
    with assms category_axioms show 
      "?H_gf⦇NTMapβ¦ˆβ¦‡d⦈ = (?H_f βˆ™NTCF ?H_g)⦇NTMapβ¦ˆβ¦‡d⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (use assms in β€Ήauto intro: cat_cs_introsβ€Ί)
qed auto

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_Comp

lemma (in category) cat_ntcf_Hom_fst_Comp:
  assumes "g : b ↦ℭ c" and "f : a ↦ℭ b"
  shows "HomA.CΞ±β„­(-,g ∘Aβ„­ f) = HomA.CΞ±β„­(-,g) βˆ™NTCF HomA.CΞ±β„­(-,f)"
proof-
  note category.cat_ntcf_Hom_snd_Comp[
      OF category_op, unfolded cat_op_simps, OF assms(2,1)
      ]
  from this category_axioms assms show ?thesis
    by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_Comp


subsubsectionβ€Ήβ€ΉHomβ€Ί-natural transformation projection of an identityβ€Ί

lemma (in category) cat_ntcf_Hom_snd_CId:
  assumes "c ∈∘ ℭ⦇Obj⦈"
  shows "HomA.CΞ±β„­(ℭ⦇CIdβ¦ˆβ¦‡c⦈,-) = ntcf_id HomO.CΞ±β„­(c,-)"
  (is β€Ή?H_c = ?id_H_cβ€Ί)
proof(rule ntcf_eqI[of Ξ±])
  from assms have "ℭ⦇CIdβ¦ˆβ¦‡c⦈ : c ↦ℭ c" by (auto simp: cat_cs_intros)
  from assms category_axioms show 
    "?H_c : HomO.CΞ±β„­(c,-) ↦CF HomO.CΞ±β„­(c,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms show 
    "?id_H_c : HomO.CΞ±β„­(c,-) ↦CF HomO.CΞ±β„­(c,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have lhs_dom: "π’Ÿβˆ˜ (?H_c⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have rhs_dom: "π’Ÿβˆ˜ (?id_H_c⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "?H_c⦇NTMap⦈ = ?id_H_c⦇NTMap⦈"
  proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
    from assms category_axioms show "vsv (?id_H_c⦇NTMap⦈)"
      by (intro is_functor.ntcf_id_NTMap_vsv) 
        (cs_concl cs_simp: cs_intro: cat_cs_intros)
    fix d assume "d ∈∘ ℭ⦇Obj⦈" 
    with assms category_axioms show "?H_c⦇NTMapβ¦ˆβ¦‡d⦈ = ?id_H_c⦇NTMapβ¦ˆβ¦‡d⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
  qed (use assms in β€Ήauto intro: cat_cs_introsβ€Ί)
qed auto

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_CId

lemma (in category) cat_ntcf_Hom_fst_CId:
  assumes "c ∈∘ ℭ⦇Obj⦈"
  shows "HomA.CΞ±β„­(-,ℭ⦇CIdβ¦ˆβ¦‡c⦈) = ntcf_id HomO.CΞ±β„­(-,c)"
proof-
  note category.cat_ntcf_Hom_snd_CId[
      OF category_op, unfolded cat_op_simps, OF assms
      ]
  from this category_axioms assms show ?thesis
    by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_CId


subsubsectionβ€Ήβ€ΉHomβ€Ί-natural transformation and the Yoneda mapβ€Ί

lemma (in category) cat_Yoneda_map_of_ntcf_Hom_snd:
  assumes "f : s ↦ℭ r"
  shows "Yoneda_map Ξ± (HomO.CΞ±β„­(s,-)) r⦇HomA.CΞ±β„­(f,-)⦈ = f"
  using category_axioms assms (*slow*)
  by
    (
      cs_concl
        cs_simp: cat_cs_simps cat_op_simps 
        cs_intro: cat_cs_intros cat_prod_cs_intros
    ) 

lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_snd

lemma (in category) cat_Yoneda_map_of_ntcf_Hom_fst:
  assumes "f : r ↦ℭ s"
  shows "Yoneda_map Ξ± (HomO.CΞ±β„­(-,s)) r⦇HomA.CΞ±β„­(-,f)⦈ = f"
proof-
  note category.cat_Yoneda_map_of_ntcf_Hom_snd[
      OF category_op, unfolded cat_op_simps, OF assms
      ]
  from this category_axioms assms show ?thesis
    by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed

lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_fst



subsectionβ€ΉEvaluation arrowβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The evaluation arrow is a part of the definition of the evaluation functor.
The evaluation functor appears in Chapter III-2 in
\cite{mac_lane_categories_2010}.
β€Ί

definition cf_eval_arrow :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_eval_arrow β„­ 𝔑 f =
    [
      (
        Ξ»xβˆˆβˆ˜π”‘β¦‡NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡β„­β¦‡Domβ¦ˆβ¦‡f⦈⦈.
          𝔑⦇NTCodβ¦ˆβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‘β¦‡NTMapβ¦ˆβ¦‡β„­β¦‡Domβ¦ˆβ¦‡fβ¦ˆβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡x⦈⦈
      ),
      𝔑⦇NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡β„­β¦‡Domβ¦ˆβ¦‡f⦈⦈,
      𝔑⦇NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡β„­β¦‡Codβ¦ˆβ¦‡f⦈⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_eval_arrow_components:
  shows "cf_eval_arrow β„­ 𝔑 f⦇ArrVal⦈ =
    (
      Ξ»xβˆˆβˆ˜π”‘β¦‡NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡β„­β¦‡Domβ¦ˆβ¦‡f⦈⦈.
        𝔑⦇NTCodβ¦ˆβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‘β¦‡NTMapβ¦ˆβ¦‡β„­β¦‡Domβ¦ˆβ¦‡fβ¦ˆβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡x⦈⦈
    )"
    and "cf_eval_arrow β„­ 𝔑 f⦇ArrDom⦈ = 𝔑⦇NTDomβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡β„­β¦‡Domβ¦ˆβ¦‡f⦈⦈"
    and "cf_eval_arrow β„­ 𝔑 f⦇ArrCod⦈ = 𝔑⦇NTCodβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡β„­β¦‡Codβ¦ˆβ¦‡f⦈⦈"
  unfolding cf_eval_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔑 β„­ 𝔉 π”Š a b f  
  assumes 𝔑: "𝔑 : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
    and f: "f : a ↦ℭ b"
begin

interpretation 𝔑: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 π”Š 𝔑 by (rule 𝔑)

lemmas cf_eval_arrow_components' = cf_eval_arrow_components[
    where β„­=β„­ and 𝔑=β€Ήntcf_arrow 𝔑› and f=f, 
    unfolded 
      ntcf_arrow_components 
      cf_map_components 
      𝔑.NTDom.HomDom.cat_is_arrD[OF f]
      cat_cs_simps
    ]

lemmas [cat_cs_simps] = cf_eval_arrow_components'(2,3)

end


subsubsectionβ€ΉArrow valueβ€Ί

context
  fixes Ξ± 𝔑 β„­ 𝔉 π”Š a b f  
  assumes 𝔑: "𝔑 : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
    and f: "f : a ↦ℭ b"
begin

mk_VLambda cf_eval_arrow_components'(1)[OF 𝔑 f]
  |vsv cf_eval_arrow_ArrVal_vsv[cat_cs_intros]|
  |vdomain cf_eval_arrow_ArrVal_vdomain[cat_cs_simps]|
  |app cf_eval_arrow_ArrVal_app[cat_cs_simps]|

end


subsubsectionβ€ΉEvaluation arrow is an arrow in the category β€ΉSetβ€Ίβ€Ί

lemma cf_eval_arrow_is_arr:
  assumes "𝔑 : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± cat_Set Ξ±" and "f : a ↦ℭ b"
  shows "cf_eval_arrow β„­ (ntcf_arrow 𝔑) f :
    𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ± π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
proof-
  interpret 𝔑: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 π”Š 𝔑 by (rule assms)
  show ?thesis
  proof
    (
      intro cat_Set_is_arrI arr_SetI, 
      unfold cf_eval_arrow_components'(2,3)[OF assms]
    )
    show "vfsequence (cf_eval_arrow β„­ (ntcf_arrow 𝔑) f)"
      unfolding cf_eval_arrow_def by simp
    show "vcard (cf_eval_arrow β„­ (ntcf_arrow 𝔑) f) = 3β„•"
      unfolding cf_eval_arrow_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (cf_eval_arrow β„­ (ntcf_arrow 𝔑) f⦇ArrVal⦈) βŠ†βˆ˜ π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      by 
      (
        unfold cf_eval_arrow_components'[OF assms], 
        intro vrange_VLambda_vsubset
      ) 
      (
        use assms in 
          β€Ήcs_concl cs_intro: cat_cs_intros cat_Set_cs_introsβ€Ί
      )+
  qed
    (
      use assms(2) in
        β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβ€Ί
    )+
qed

lemma cf_eval_arrow_is_arr'[cat_cs_intros]:
  assumes "𝔑' = ntcf_arrow 𝔑"
    and "𝔉a = 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "π”Šb = π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "𝔑 : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± cat_Set Ξ±" 
    and "f : a ↦ℭ b"
  shows "cf_eval_arrow β„­ 𝔑' f : 𝔉a ↦cat_Set Ξ± π”Šb"
  using assms(4,5) unfolding assms(1-3) by (rule cf_eval_arrow_is_arr)

lemma (in category) cat_cf_eval_arrow_ntcf_vcomp[cat_cs_simps]:
  assumes "𝔐 : π”Š ↦CF β„Œ : β„­ ↦↦CΞ± cat_Set Ξ±" 
    and "𝔑 : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "g : b ↦ℭ c"
    and "f : a ↦ℭ b"
  shows 
    "cf_eval_arrow β„­ (ntcf_arrow (𝔐 βˆ™NTCF 𝔑)) (g ∘Aβ„­ f) =
      cf_eval_arrow β„­ (ntcf_arrow 𝔐) g ∘Acat_Set Ξ±
      cf_eval_arrow β„­ (ntcf_arrow 𝔑) f"
proof-

  interpret 𝔐: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί π”Š β„Œ 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 π”Š 𝔑 by (rule assms(2))

  have 𝔐𝔑: "𝔐 βˆ™NTCF 𝔑 : 𝔉 ↦CF β„Œ : β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(3,4) have gf: "g ∘Aβ„­ f : a ↦ℭ c"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 𝔐𝔑 gf have cf_eval_gf:
    "cf_eval_arrow β„­ (ntcf_arrow (𝔐 βˆ™NTCF 𝔑)) (g ∘Aβ„­ f) :
      𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ± β„Œβ¦‡ObjMapβ¦ˆβ¦‡c⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(3,4) have cf_eval_g_cf_eval_f:
    "cf_eval_arrow β„­ (ntcf_arrow 𝔐) g ∘Acat_Set Ξ±
      cf_eval_arrow β„­ (ntcf_arrow 𝔑) f :
      𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ± β„Œβ¦‡ObjMapβ¦ˆβ¦‡c⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  note cf_eval_gf = cf_eval_gf cat_Set_is_arrD[OF cf_eval_gf]
  note cf_eval_g_cf_eval_f = 
    cf_eval_g_cf_eval_f cat_Set_is_arrD[OF cf_eval_g_cf_eval_f]

  interpret arr_Set_cf_eval_gf:
    arr_Set Ξ± β€Ήcf_eval_arrow β„­ (ntcf_arrow (𝔐 βˆ™NTCF 𝔑)) (g ∘Aβ„­ f)β€Ί
    by (rule cf_eval_gf(2))
  interpret arr_Set_cf_eval_g_cf_eval_f:
    arr_Set 
      Ξ± 
      β€Ή
        cf_eval_arrow β„­ (ntcf_arrow 𝔐) g ∘Acat_Set Ξ±
        cf_eval_arrow β„­ (ntcf_arrow 𝔑) f
      β€Ί
    by (rule cf_eval_g_cf_eval_f(2))

  show ?thesis
  proof(rule arr_Set_eqI)
    from 𝔐𝔑 gf have dom_lhs:
      "π’Ÿβˆ˜ (cf_eval_arrow β„­ (ntcf_arrow (𝔐 βˆ™NTCF 𝔑)) (g ∘Aβ„­ f)⦇ArrVal⦈) = 
        𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    from cf_eval_g_cf_eval_f(1) have dom_rhs: 
      "π’Ÿβˆ˜
        (
          (
            cf_eval_arrow β„­ (ntcf_arrow 𝔐) g ∘Acat_Set Ξ±
            cf_eval_arrow β„­ (ntcf_arrow 𝔑) f
          )⦇ArrVal⦈
        ) = 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    show
      "cf_eval_arrow β„­ (ntcf_arrow (𝔐 βˆ™NTCF 𝔑)) (g ∘Aβ„­ f)⦇ArrVal⦈ =
        (
          cf_eval_arrow β„­ (ntcf_arrow 𝔐) g ∘Acat_Set Ξ±
          cf_eval_arrow β„­ (ntcf_arrow 𝔑) f
        )⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix 𝔉a assume prems: "𝔉a ∈∘ 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
      from 
        ArrVal_eq_helper
          [
            OF 𝔐.ntcf_Comp_commute[OF assms(4), symmetric], 
            where a=‹𝔑⦇NTMapβ¦ˆβ¦‡aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‰aβ¦ˆβ€Ί
          ] 
        prems 
        assms(3,4) 
      have [cat_cs_simps]:
        "β„Œβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”β¦‡NTMapβ¦ˆβ¦‡aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‘β¦‡NTMapβ¦ˆβ¦‡aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‰a⦈⦈⦈ =
          𝔐⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”Šβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‘β¦‡NTMapβ¦ˆβ¦‡aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‰a⦈⦈⦈"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
          )
      from prems assms(3,4) show 
        "cf_eval_arrow β„­ (ntcf_arrow (𝔐 βˆ™NTCF 𝔑)) (g ∘Aβ„­ f)⦇ArrValβ¦ˆβ¦‡π”‰a⦈ =
          (
            cf_eval_arrow β„­ (ntcf_arrow 𝔐) g ∘Acat_Set Ξ±
            cf_eval_arrow β„­ (ntcf_arrow 𝔑) f
          )⦇ArrValβ¦ˆβ¦‡π”‰a⦈"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
          )
    qed (cs_concl cs_intro: V_cs_intros)
  qed
    (
      auto
        simp: cf_eval_gf cf_eval_g_cf_eval_f 
        intro: cf_eval_gf(2) cf_eval_g_cf_eval_f(2)
    )

qed

lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_vcomp

lemma (in category) cat_cf_eval_arrow_ntcf_id[cat_cs_simps]:
  assumes "𝔉 : β„­ ↦↦CΞ± cat_Set Ξ±" and "c ∈∘ ℭ⦇Obj⦈"
  shows 
    "cf_eval_arrow β„­ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈) =
      cat_Set α⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈"
proof-

  interpret 𝔉: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 by (rule assms)

  from assms(2) have ntcf_id_CId_c: 
    "cf_eval_arrow β„­ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈) :
      𝔉⦇ObjMapβ¦ˆβ¦‡c⦈ ↦cat_Set Ξ± 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈"
    by (cs_concl cs_intro: cat_cs_intros)
  from assms(2) have CId_𝔉c:
    "cat_Set α⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈ ↦cat_Set Ξ± 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈"
    by (cs_concl cs_intro: cat_cs_intros)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])

    from ntcf_id_CId_c show arr_Set_ntcf_id_CId_c:
      "arr_Set Ξ± (cf_eval_arrow β„­ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈))"
      by (auto dest: cat_Set_is_arrD(1))
    from ntcf_id_CId_c have dom_lhs:
      "π’Ÿβˆ˜ (cf_eval_arrow β„­ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇ArrVal⦈) =
        𝔉⦇ObjMapβ¦ˆβ¦‡c⦈"
      by (cs_concl cs_simp: cat_cs_simps)+
    interpret ntcf_id_CId_c: 
      arr_Set Ξ± β€Ήcf_eval_arrow β„­ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈)β€Ί
      by (rule arr_Set_ntcf_id_CId_c)
  
    from CId_𝔉c show arr_Set_CId_𝔉c: "arr_Set Ξ± (cat_Set α⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈)"
      by (auto dest: cat_Set_is_arrD(1))
    from CId_𝔉c assms(2) have dom_rhs: 
      "π’Ÿβˆ˜ ((cat_Set α⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡c⦈⦈)⦇ArrVal⦈) = 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈" 
      by (cs_concl cs_simp: cat_cs_simps)

    show 
      "cf_eval_arrow β„­ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇ArrVal⦈ =
        cat_Set α⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡cβ¦ˆβ¦ˆβ¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈"
      with category_axioms assms(2) show 
        "cf_eval_arrow β„­ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇ArrValβ¦ˆβ¦‡a⦈ =
          cat_Set α⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡cβ¦ˆβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (use arr_Set_ntcf_id_CId_c arr_Set_CId_𝔉c in auto)

  qed (use ntcf_id_CId_c CId_𝔉c in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_id



subsectionβ€Ήβ€ΉHOMβ€Ί-functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The following definition is a technical generalization that is used
later in this section.
β€Ί

definition cf_HOM_snd :: "V β‡’ V β‡’ V" (β€ΉHOMCΔ±'(/,_-/')β€Ί)
  where "HOMCΞ±(,𝔉-) =
    [
      (Ξ»a∈∘op_cat (𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.CΞ±(𝔉⦇HomCod⦈)(a,-) ∘CF 𝔉)),
      (
        Ξ»f∈∘op_cat (𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.CΞ±(𝔉⦇HomCod⦈)(f,-) ∘NTCF-CF 𝔉)
      ),
      op_cat (𝔉⦇HomCod⦈),
      cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±)
    ]∘"

definition cf_HOM_fst :: "V β‡’ V β‡’ V" (β€ΉHOMCΔ±'(/_-,/')β€Ί)
  where "HOMCΞ±(𝔉-,) =
    [
      (Ξ»a∈∘(𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.CΞ±(𝔉⦇HomCod⦈)(-,a) ∘CF op_cf 𝔉)),
      (
        Ξ»f∈∘(𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.CΞ±(𝔉⦇HomCod⦈)(-,f) ∘NTCF-CF op_cf 𝔉)
      ),
      𝔉⦇HomCod⦈,
      cat_FUNCT Ξ± (op_cat (𝔉⦇HomDom⦈)) (cat_Set Ξ±)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_HOM_snd_components:
  shows "HOMCΞ±(,𝔉-)⦇ObjMap⦈ =
      (Ξ»a∈∘op_cat (𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.CΞ±(𝔉⦇HomCod⦈)(a,-) ∘CF 𝔉))"
    and "HOMCΞ±(,𝔉-)⦇ArrMap⦈ =
      (
        Ξ»f∈∘op_cat (𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.CΞ±(𝔉⦇HomCod⦈)(f,-) ∘NTCF-CF 𝔉)
      )"
    and [cat_cs_simps]: "HOMCΞ±(,𝔉-)⦇HomDom⦈ = op_cat (𝔉⦇HomCod⦈)"
    and [cat_cs_simps]: 
      "HOMCΞ±(,𝔉-)⦇HomCod⦈ = cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±)"
  unfolding cf_HOM_snd_def dghm_field_simps by (simp_all add: nat_omega_simps)

lemma cf_HOM_fst_components:
  shows "HOMCΞ±(𝔉-,)⦇ObjMap⦈ = 
      (Ξ»a∈∘(𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.CΞ±(𝔉⦇HomCod⦈)(-,a) ∘CF op_cf 𝔉))"
    and "HOMCΞ±(𝔉-,)⦇ArrMap⦈ = 
      (
        Ξ»f∈∘(𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.CΞ±(𝔉⦇HomCod⦈)(-,f) ∘NTCF-CF op_cf 𝔉)
      )"
    and "HOMCΞ±(𝔉-,)⦇HomDom⦈ = 𝔉⦇HomCod⦈"
    and "HOMCΞ±(𝔉-,)⦇HomCod⦈ = cat_FUNCT Ξ± (op_cat (𝔉⦇HomDom⦈)) (cat_Set Ξ±)"
  unfolding cf_HOM_fst_def dghm_field_simps by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas cf_HOM_snd_components' = 
  cf_HOM_snd_components[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]

lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)

lemmas cf_HOM_fst_components' = 
  cf_HOM_fst_components[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]

lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)

end


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda cf_HOM_snd_components(1)
  |vsv cf_HOM_snd_ObjMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_snd_components'(1)[unfolded cat_op_simps]
  |vdomain cf_HOM_snd_ObjMap_vdomain[cat_cs_simps]|
  |app cf_HOM_snd_ObjMap_app[cat_cs_simps]|

mk_VLambda cf_HOM_snd_components(1)
  |vsv cf_HOM_fst_ObjMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_fst_components'(1)[unfolded cat_op_simps]
  |vdomain cf_HOM_fst_ObjMap_vdomain[cat_cs_simps]|
  |app cf_HOM_fst_ObjMap_app[cat_cs_simps]|


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda cf_HOM_snd_components(2)
  |vsv cf_HOM_snd_ArrMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_snd_components'(2)[unfolded cat_op_simps]
  |vdomain cf_HOM_snd_ArrMap_vdomain[cat_cs_simps]|
  |app cf_HOM_snd_ArrMap_app[cat_cs_simps]|

mk_VLambda cf_HOM_fst_components(2)
  |vsv cf_HOM_fst_ArrMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_fst_components'(2)[unfolded cat_op_simps]
  |vdomain cf_HOM_fst_ArrMap_vdomain[cat_cs_simps]|
  |app cf_HOM_fst_ArrMap_app[cat_cs_simps]|


subsubsectionβ€ΉOpposite β€ΉHOMβ€Ί-functorβ€Ί

lemma (in is_functor) cf_HOM_snd_op[cat_op_simps]: 
  "HOMCΞ±(,op_cf 𝔉-) = HOMCΞ±(𝔉-,)"
proof-
  have dom_lhs: "π’Ÿβˆ˜ HOMCΞ±(,op_cf 𝔉-) = 4β„•"
    unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ HOMCΞ±(𝔉-,) = 4β„•"
    unfolding cf_HOM_fst_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume "a ∈∘ 4β„•"
    then show "HOMCΞ±(,op_cf 𝔉-)⦇a⦈ = HOMCΞ±(𝔉-,)⦇a⦈"
    proof
      (
        elim_in_numeral, 
        use nothing in β€Ήfold dghm_field_simps, unfold cat_cs_simpsβ€Ί
      )
      show "HOMCΞ±(,op_cf 𝔉-)⦇ObjMap⦈ = HOMCΞ±(𝔉-,)⦇ObjMap⦈"
        unfolding 
          cf_HOM_fst_components' 
          is_functor.cf_HOM_snd_components'[OF is_functor_op]
        by (rule VLambda_eqI, unfold cat_op_simps)
         (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)+
      show "HOMCΞ±(,op_cf 𝔉-)⦇ArrMap⦈ = HOMCΞ±(𝔉-,)⦇ArrMap⦈"
        unfolding 
          cf_HOM_fst_components' 
          is_functor.cf_HOM_snd_components'[OF is_functor_op]
        by (rule VLambda_eqI, unfold cat_op_simps)
          (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+ 
    qed 
      (
        auto simp:
          cf_HOM_fst_components' cat_cs_simps cat_op_simps cat_op_intros
      )
  qed (auto simp: cf_HOM_snd_def cf_HOM_fst_def)
qed

lemmas [cat_op_simps] = is_functor.cf_HOM_snd_op

context is_functor
begin

lemmas cf_HOM_fst_op[cat_op_simps] = 
  is_functor.cf_HOM_snd_op[OF is_functor_op, unfolded cat_op_simps, symmetric]

end

lemmas [cat_op_simps] = is_functor.cf_HOM_fst_op


subsubsectionβ€Ήβ€ΉHOMβ€Ί-functor is a functorβ€Ί

lemma (in is_functor) cf_HOM_snd_is_functor: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "HOMCΞ±(,𝔉-) : op_cat 𝔅 ↦↦CΞ² cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)"
proof-

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret Ξ²β„­: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+

  show ?thesis
  proof(intro is_functorI', unfold cat_op_simps)
    show "vfsequence HOMCΞ±(,𝔉-)" unfolding cf_HOM_snd_def by auto
    show "vcard HOMCΞ±(,𝔉-) = 4β„•"
      unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (HOMCΞ±(,𝔉-)⦇ObjMap⦈) βŠ†βˆ˜ cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)⦇Obj⦈"
      unfolding cf_HOM_snd_components'
    proof(rule vrange_VLambda_vsubset, unfold cat_op_simps)
      fix b assume prems: "b ∈∘ 𝔅⦇Obj⦈"
      with assms(2) show 
        "cf_map (HomO.Cα𝔅(b,-) ∘CF 𝔉) ∈∘ cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)⦇Obj⦈"
        by
          (
            cs_concl
              cs_simp: cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
    show 
      "HOMCΞ±(,𝔉-)⦇ArrMapβ¦ˆβ¦‡f ∘A𝔅 g⦈ = 
        HOMCΞ±(,𝔉-)⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Acat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)
        HOMCΞ±(,𝔉-)⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : c ↦𝔅 b" and "f : b ↦𝔅 a" for b c g a f
      using that 
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    show 
      "HOMCΞ±(,𝔉-)⦇ArrMapβ¦ˆβ¦‡π”…β¦‡CIdβ¦ˆβ¦‡c⦈⦈ =
        cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)⦇CIdβ¦ˆβ¦‡HOMCΞ±(,𝔉-)⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ 𝔅⦇Obj⦈" for c 
      using that
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed 
    (
      use assms(2) in
        β€Ή
          cs_concl
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        β€Ί
    )+

qed

lemma (in is_functor) cf_HOM_snd_is_functor'[cat_cs_intros]: 
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "β„­' = op_cat 𝔅"
    and "𝔇 = cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)"
  shows "HOMCΞ±(,𝔉-) : β„­' ↦↦CΞ² 𝔇"
  using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_snd_is_functor)

lemmas [cat_cs_intros] = is_functor.cf_HOM_snd_is_functor'

lemma (in is_functor) cf_HOM_fst_is_functor: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "HOMCΞ±(𝔉-,) : 𝔅 ↦↦CΞ² cat_FUNCT Ξ± (op_cat 𝔄) (cat_Set Ξ±)"
  by 
    (
      rule is_functor.cf_HOM_snd_is_functor[
        OF is_functor_op assms, unfolded cat_op_simps
        ]
   )

lemma (in is_functor) cf_HOM_fst_is_functor'[cat_cs_intros]: 
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "β„­' = 𝔅"
    and "𝔇 = cat_FUNCT Ξ± (op_cat 𝔄) (cat_Set Ξ±)"
  shows "HOMCΞ±(𝔉-,) : β„­' ↦↦CΞ² 𝔇"
  using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_fst_is_functor)

lemmas [cat_cs_intros] = is_functor.cf_HOM_fst_is_functor'



subsectionβ€ΉEvaluation functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III-2 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_eval :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_eval Ξ± Ξ² β„­ =
    [
      (λ𝔉d∈∘(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈. 𝔉d⦇0β¦ˆβ¦‡ObjMapβ¦ˆβ¦‡π”‰d⦇1β„•β¦ˆβ¦ˆ),
      (
        λ𝔑f∈∘(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Arr⦈.
          cf_eval_arrow β„­ (𝔑f⦇0⦈) (𝔑f⦇1β„•β¦ˆ)
      ),
      cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­,
      cat_Set Ξ²
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_eval_components:
  shows "cf_eval Ξ± Ξ² ℭ⦇ObjMap⦈ =
    (λ𝔉d∈∘(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈. 𝔉d⦇0β¦ˆβ¦‡ObjMapβ¦ˆβ¦‡π”‰d⦇1β„•β¦ˆβ¦ˆ)"
    and "cf_eval Ξ± Ξ² ℭ⦇ArrMap⦈ =
      (
        λ𝔑f∈∘(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Arr⦈.
          cf_eval_arrow β„­ (𝔑f⦇0⦈) (𝔑f⦇1β„•β¦ˆ)
      )"
    and [cat_cs_simps]: 
      "cf_eval Ξ± Ξ² ℭ⦇HomDom⦈ = cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­"
    and [cat_cs_simps]: "cf_eval Ξ± Ξ² ℭ⦇HomCod⦈ = cat_Set Ξ²"
  unfolding cf_eval_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_eval_ObjMap_vsv[cat_cs_intros]: "vsv (cf_eval Ξ± Ξ² ℭ⦇ObjMap⦈)"
  unfolding cf_eval_components by simp

lemma cf_eval_ObjMap_vdomain[cat_cs_simps]: 
  "π’Ÿβˆ˜ (cf_eval Ξ± Ξ² ℭ⦇ObjMap⦈) = (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈"
  unfolding cf_eval_components by simp

lemma (in category) cf_eval_ObjMap_app[cat_cs_simps]: 
  assumes "𝔉c = [cf_map 𝔉, c]∘"
    and "𝔉 : β„­ ↦↦CΞ± cat_Set Ξ±" (*the order of premises is important*)
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰c⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈"
proof-
  interpret 𝔉: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 by (rule assms(2))
  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝒡_Limit_Ξ±Ο‰ 𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 
  note [cat_small_cs_intros] = cat_category_if_ge_Limit
  from assms(2,3) Ξ±Ξ² have "𝔉c ∈∘ (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈"
    by 
      (
        cs_concl 
          cs_simp: assms(1) cat_FUNCT_components(1)
          cs_intro: 
            cat_cs_intros 
            cat_small_cs_intros 
            cat_prod_cs_intros 
            cat_FUNCT_cs_intros
      )
  then show ?thesis
    by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed

lemmas [cat_cs_simps] = category.cf_eval_ObjMap_app


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_eval_ArrMap_vsv[cat_cs_intros]: "vsv (cf_eval Ξ± Ξ² ℭ⦇ArrMap⦈)"
  unfolding cf_eval_components by simp

lemma cf_eval_ArrMap_vdomain[cat_cs_simps]: 
  "π’Ÿβˆ˜ (cf_eval Ξ± Ξ² ℭ⦇ArrMap⦈) = (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Arr⦈"
  unfolding cf_eval_components by simp

lemma (in category) cf_eval_ArrMap_app[cat_cs_simps]: 
  assumes "𝔑f = [ntcf_arrow 𝔑, f]∘"
    and "𝔑 : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "f : a ↦ℭ b"
  shows "cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”‘f⦈ = cf_eval_arrow β„­ (ntcf_arrow 𝔑) f"
proof-
  interpret 𝔉: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 π”Š 𝔑 by (rule assms(2))
  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝒡_Limit_Ξ±Ο‰ 𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 
  note [cat_small_cs_intros] = cat_category_if_ge_Limit
  from assms(1,3) Ξ±Ξ² have "𝔑f ∈∘ (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Arr⦈"
    by 
      (
        cs_concl
          cs_simp: assms(1) cat_FUNCT_components(1)
          cs_intro: 
            cat_cs_intros 
            cat_small_cs_intros 
            cat_prod_cs_intros 
            cat_FUNCT_cs_intros
      )
  then show ?thesis
    by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed

lemmas [cat_cs_simps] = category.cf_eval_ArrMap_app


subsubsectionβ€ΉEvaluation functor is a functorβ€Ί

lemma (in category) cat_cf_eval_is_functor:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "cf_eval Ξ± Ξ² β„­ : cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ ↦↦CΞ² cat_Set Ξ²"
proof-

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  from assms(2) cat_category_if_ge_Limit[OF assms] interpret FUNCT: 
    category Ξ² β€Ή(cat_FUNCT Ξ± β„­ (cat_Set Ξ±))β€Ί
    by 
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret Ξ²β„­: category Ξ² β„­
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret cat_Set_Ξ±Ξ²: subcategory Ξ² β€Ήcat_Set Ξ±β€Ί β€Ήcat_Set Ξ²β€Ί
    by (rule subcategory_cat_Set_cat_Set[OF assms])
  
  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (cf_eval Ξ± Ξ² β„­)" unfolding cf_eval_def by simp
    from cat_category_if_ge_Limit[OF assms] show 
      "category Ξ² ((cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) Γ—C β„­)"
      by (cs_concl cs_simp: cs_intro: cat_small_cs_intros cat_cs_intros)
    show "vcard (cf_eval Ξ± Ξ² β„­) = 4β„•" 
      unfolding cf_eval_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (cf_eval Ξ± Ξ² ℭ⦇ObjMap⦈) βŠ†βˆ˜ cat_Set β⦇Obj⦈"
    proof(intro vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
      fix 𝔉c assume prems: "𝔉c ∈∘ (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈"
      then obtain 𝔉 c 
        where 𝔉c_def: "𝔉c = [𝔉, c]∘"
          and 𝔉: "𝔉 ∈∘ cf_maps Ξ± β„­ (cat_Set Ξ±)"
          and c: "c ∈∘ ℭ⦇Obj⦈"
        by 
          (
            auto 
              elim: cat_prod_2_ObjE[rotated 2] 
              intro: FUNCT.category_axioms Ξ²β„­.category_axioms
              simp: cat_FUNCT_components(1)
          )
      from 𝔉 obtain π”Š where 𝔉_def: "𝔉 = cf_map π”Š"
        and π”Š: "π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
        by (elim cf_mapsE)        
      interpret π”Š: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί π”Š by (rule π”Š)
      from π”Š c show "cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰c⦈ ∈∘ cat_Set β⦇Obj⦈"
        unfolding 𝔉c_def 𝔉_def 
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_Set_Ξ±Ξ².subcat_Obj_vsubset
          )
    qed (cs_concl cs_intro: cat_cs_intros)
    show "cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”‘f⦈ :
      cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰a⦈ ↦cat_Set Ξ² cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”Šb⦈"
      if 𝔑f: "𝔑f : 𝔉a ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ π”Šb" for 𝔉a π”Šb 𝔑f
    proof-
      obtain 𝔑 f 𝔉 a π”Š b
        where 𝔑f_def: "𝔑f = [𝔑, f]∘" 
          and 𝔉a_def: "𝔉a = [𝔉, a]∘"
          and π”Šb_def: "π”Šb = [π”Š, b]∘" 
          and 𝔑: "𝔑 : 𝔉 ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) π”Š" 
          and f: "f : a ↦ℭ b"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔑f] 
              FUNCT.category_axioms 
              Ξ²β„­.category_axioms
          )
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
      from 𝔑(1) f assms(2) show "cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”‘f⦈ :
        cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰a⦈ ↦cat_Set Ξ² cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”Šb⦈"
        unfolding 𝔑f_def 𝔉a_def π”Šb_def
        by
          (
            intro cat_Set_Ξ±Ξ².subcat_is_arrD,
            use nothing in β€Ήsubst 𝔑(2), subst 𝔑(3), subst 𝔑(4)β€Ί
          )
          (
            cs_concl
              cs_simp: cat_FUNCT_cs_simps cat_cs_simps cs_intro: cat_cs_intros 
          ) (*slow*)
    qed
    show 
      "cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”g ∘Acat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ 𝔑f⦈ =
        cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”g⦈ ∘Acat_Set Ξ² cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”‘f⦈"
      if 𝔐g: "𝔐g : π”Šb ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ β„Œc"
        and 𝔑f: "𝔑f : 𝔉a ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ π”Šb"
      for 𝔑f 𝔐g 𝔉a π”Šb β„Œc
    proof-
      obtain 𝔑 f 𝔉 a π”Š b
        where 𝔑f_def: "𝔑f = [𝔑, f]∘" 
          and 𝔉a_def: "𝔉a = [𝔉, a]∘"
          and π”Šb_def: "π”Šb = [π”Š, b]∘" 
          and 𝔑: "𝔑 : 𝔉 ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) π”Š" 
          and f: "f : a ↦ℭ b"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔑f] 
              FUNCT.category_axioms 
              Ξ²β„­.category_axioms
          )
      then obtain 𝔐 g β„Œ c
        where 𝔐g_def: "𝔐g = [𝔐, g]∘" 
          and β„Œc_def: "β„Œc = [β„Œ, c]∘" 
          and 𝔐: "𝔐 : π”Š ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) β„Œ"
          and g: "g : b ↦ℭ c"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔐g] 
              FUNCT.category_axioms
              Ξ²β„­.category_axioms
          )
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
        and 𝔐 = cat_FUNCT_is_arrD[OF 𝔐]
      from 𝔑(1) 𝔐(1) f g show
        "cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”g ∘Acat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ 𝔑f⦈ =
          cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”g⦈ ∘Acat_Set Ξ² cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”‘f⦈"
        unfolding 𝔐g_def 𝔑f_def 𝔉a_def π”Šb_def β„Œc_def
        by 
          (
            subst (1 2) 𝔐(2), use nothing in β€Ήsubst (1 2) 𝔑(2)β€Ί, 
            cs_concl_step cat_Set_Ξ±Ξ².subcat_Comp_simp[symmetric]
          )
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
          )
    qed
    show
      "cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇CIdβ¦ˆβ¦‡π”‰c⦈⦈ =
        cat_Set β⦇CIdβ¦ˆβ¦‡cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰c⦈⦈"
      if "𝔉c ∈∘ (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈" for 𝔉c
    proof-
      from that obtain 𝔉 c where 𝔉c_def: "𝔉c = [𝔉, c]∘"
        and 𝔉: "𝔉 ∈∘ cf_maps Ξ± β„­ (cat_Set Ξ±)"
        and c: "c ∈∘ ℭ⦇Obj⦈"
        by 
          (
            auto 
              elim: cat_prod_2_ObjE[rotated 2] 
              intro: FUNCT.category_axioms Ξ²β„­.category_axioms
              simp: cat_FUNCT_components(1)
          )
      from 𝔉 obtain π”Š where 𝔉_def: "𝔉 = cf_map π”Š"
        and π”Š: "π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
        by (elim cf_mapsE)
      interpret π”Š: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί π”Š by (rule π”Š)
      from π”Š c show 
        "cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇CIdβ¦ˆβ¦‡π”‰c⦈⦈ =
          cat_Set β⦇CIdβ¦ˆβ¦‡cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰c⦈⦈"
        unfolding 𝔉c_def 𝔉_def
        by (cs_concl_step cat_Set_Ξ±Ξ².subcat_CId[symmetric])
          (
            cs_concl
              cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
          )
    qed

  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

qed

lemma (in category) cat_cf_eval_is_functor':
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "𝔄' = cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­"
    and "𝔅' = cat_Set Ξ²"
    and "Ξ²' = Ξ²"
  shows "cf_eval Ξ± Ξ² β„­ : 𝔄' ↦↦CΞ²' 𝔅'"
  using assms(1,2) unfolding assms(3-5) by (rule cat_cf_eval_is_functor) 

lemmas [cat_cs_intros] = category.cat_cf_eval_is_functor'



subsectionβ€Ήβ€ΉNβ€Ί-functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III-2 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_nt :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_nt Ξ± Ξ² 𝔉 =
    bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±))
      (HomO.CΞ²cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))"


textβ€ΉAlternative definition.β€Ί

lemma (in is_functor) cf_nt_def':
  "cf_nt Ξ± Ξ² 𝔉 =
    bifunctor_flip 𝔅 (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±))
      (HomO.CΞ²cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))"
  unfolding cf_nt_def cf_HomDom cf_HomCod by simp


textβ€ΉComponents.β€Ί

lemma cf_nt_components:
  shows "cf_nt Ξ± Ξ² 𝔉⦇ObjMap⦈ =
    (
      bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±))
        (HomO.CΞ²cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
    )⦇ObjMap⦈"
    and "cf_nt Ξ± Ξ² 𝔉⦇ArrMap⦈ =
      (
        bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±))
          (HomO.CΞ²cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
      )⦇ArrMap⦈"
    and "cf_nt Ξ± Ξ² 𝔉⦇HomDom⦈ =
      (
        bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±))
          (HomO.CΞ²cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
      )⦇HomDom⦈"
    and "cf_nt Ξ± Ξ² 𝔉⦇HomCod⦈ =
      (
        bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±))
          (HomO.CΞ²cat_FUNCT Ξ± (𝔉⦇HomDom⦈) (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
      )⦇HomCod⦈"
  unfolding cf_nt_def by simp_all

lemma (in is_functor) cf_nt_components':
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "cf_nt Ξ± Ξ² 𝔉⦇ObjMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±))
          (HomO.CΞ²cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
      )⦇ObjMap⦈"
    and "cf_nt Ξ± Ξ² 𝔉⦇ArrMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±))
          (HomO.CΞ²cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
      )⦇ArrMap⦈"
    and [cat_cs_simps]: 
      "cf_nt Ξ± Ξ² 𝔉⦇HomDom⦈ = cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±) Γ—C 𝔅"
    and [cat_cs_simps]: 
      "cf_nt Ξ± Ξ² 𝔉⦇HomCod⦈ = cat_Set Ξ²"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret β𝔄: category Ξ² 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  show 
    "cf_nt Ξ± Ξ² 𝔉⦇ObjMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±))
          (HomO.CΞ²cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
      )⦇ObjMap⦈"
    "cf_nt Ξ± Ξ² 𝔉⦇ArrMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±))
          (HomO.CΞ²cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)(HOMCΞ±(,𝔉-)-,-))
      )⦇ArrMap⦈"
    "cf_nt Ξ± Ξ² 𝔉⦇HomDom⦈ = cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±) Γ—C 𝔅"
    "cf_nt Ξ± Ξ² 𝔉⦇HomCod⦈ = cat_Set Ξ²"
    unfolding cf_nt_def 
    using assms(2)
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )+
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_components'(3,4)


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_nt_ObjMap_vsv[cat_cs_intros]: "vsv (cf_nt Ξ± Ξ² ℭ⦇ObjMap⦈)"
  unfolding cf_nt_components by (cs_intro_step cat_cs_intros)

lemma (in is_functor) cf_nt_ObjMap_vdomain[cat_cs_simps]: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "π’Ÿβˆ˜ (cf_nt Ξ± Ξ² 𝔉⦇ObjMap⦈) = (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±) Γ—C 𝔅)⦇Obj⦈"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret β𝔄: category Ξ² 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  from assms(2) show ?thesis
    unfolding cf_nt_components
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro: 
            cat_small_cs_intros
            cat_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_vdomain

lemma (in is_functor) cf_nt_ObjMap_app[cat_cs_simps]: 
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "π”Šb = [cf_map π”Š, b]∘"
    and "π”Š : 𝔄 ↦↦CΞ± cat_Set Ξ±"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "cf_nt Ξ± Ξ² 𝔉⦇ObjMapβ¦ˆβ¦‡π”Šb⦈ = Hom
    (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±))
    (cf_map (HomO.Cα𝔅(b,-) ∘CF 𝔉))
    (cf_map π”Š)"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret β𝔄: category Ξ² 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret π”Š: is_functor Ξ± 𝔄 β€Ήcat_Set Ξ±β€Ί π”Š by (rule assms(4))
  from assms(2,5) show ?thesis
    unfolding assms(3) cf_nt_def
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps 
          cs_intro:
            cat_cs_intros
            cat_small_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros 
            cat_op_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_app


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_nt_ArrMap_vsv[cat_cs_intros]: "vsv (cf_nt Ξ± Ξ² ℭ⦇ArrMap⦈)"
  unfolding cf_nt_components by (cs_intro_step cat_cs_intros)

lemma (in is_functor) cf_nt_ArrMap_vdomain[cat_cs_simps]: 
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "π’Ÿβˆ˜ (cf_nt Ξ± Ξ² 𝔉⦇ArrMap⦈) = (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±) Γ—C 𝔅)⦇Arr⦈"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret β𝔄: category Ξ² 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  from assms(2) show ?thesis
    unfolding cf_nt_components
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro: 
            cat_small_cs_intros
            cat_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_vdomain

lemma (in is_functor) cf_nt_ArrMap_app[cat_cs_simps]: 
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "𝔑f = [ntcf_arrow 𝔑, f]∘"
    and "𝔑 : π”Š ↦CF β„Œ : 𝔄 ↦↦CΞ± cat_Set Ξ±"
    and "f : a ↦𝔅 b"
  shows "cf_nt Ξ± Ξ² 𝔉⦇ArrMapβ¦ˆβ¦‡π”‘f⦈ = cf_hom
    (cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±))
    [ntcf_arrow (HomA.Cα𝔅(f,-) ∘NTCF-CF 𝔉), ntcf_arrow 𝔑]∘"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret β𝔄: category Ξ² 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret 𝔑: is_ntcf Ξ± 𝔄 β€Ήcat_Set Ξ±β€Ί π”Š β„Œ 𝔑 by (rule assms(4))
  from assms(2,5) show ?thesis
    unfolding assms(3) cf_nt_def
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro:
            cat_cs_intros
            cat_small_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros
            cat_op_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_app


subsubsectionβ€Ήβ€ΉNβ€Ί-functor is a functorβ€Ί

lemma (in is_functor) cf_nt_is_functor:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "cf_nt Ξ± Ξ² 𝔉 : cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±) Γ—C 𝔅 ↦↦CΞ² cat_Set Ξ²"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret β𝔄: category Ξ² 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  from assms(2) show ?thesis
    unfolding cf_nt_def'
    by 
      (
        cs_concl 
          cs_simp: cat_op_simps 
          cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
qed

lemma (in is_functor) cf_nt_is_functor':
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "𝔄' = cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±) Γ—C 𝔅"
    and "𝔅' = cat_Set Ξ²"
    and "Ξ²' = Ξ²"
  shows "cf_nt Ξ± Ξ² 𝔉 : 𝔄' ↦↦CΞ²' 𝔅'"
  using assms(1,2) unfolding assms(3-5) by (rule cf_nt_is_functor) 

lemmas [cat_cs_intros] = is_functor.cf_nt_is_functor'



subsectionβ€ΉYoneda natural transformation arrowβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The following subsection is based on the elements of the content
of Chapter III-2 in \cite{mac_lane_categories_2010}. 
β€Ί

definition ntcf_Yoneda_arrow :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_Yoneda_arrow Ξ± β„­ 𝔉 r =
    [
      (
        λψ∈∘Hom (cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) (cf_map (HomO.CΞ±β„­(r,-))) 𝔉.
          Yoneda_map Ξ± (cf_of_cf_map β„­ (cat_Set Ξ±) 𝔉) r⦇
            ntcf_of_ntcf_arrow β„­ (cat_Set Ξ±) ψ
            ⦈
      ),
      Hom (cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) (cf_map (HomO.CΞ±β„­(r,-))) 𝔉,
      𝔉⦇ObjMapβ¦ˆβ¦‡r⦈
    ]∘"


textβ€ΉComponentsβ€Ί

lemma ntcf_Yoneda_arrow_components:
  shows "ntcf_Yoneda_arrow Ξ± β„­ 𝔉 r⦇ArrVal⦈ = 
    (
      λψ∈∘Hom (cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) (cf_map (HomO.CΞ±β„­(r,-))) 𝔉.
        Yoneda_map Ξ± (cf_of_cf_map β„­ (cat_Set Ξ±) 𝔉) r⦇
          ntcf_of_ntcf_arrow β„­ (cat_Set Ξ±) ψ
          ⦈
    )"
    and [cat_cs_simps]: "ntcf_Yoneda_arrow Ξ± β„­ 𝔉 r⦇ArrDom⦈ = 
      Hom (cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) (cf_map (HomO.CΞ±β„­(r,-))) 𝔉"
    and [cat_cs_simps]: "ntcf_Yoneda_arrow Ξ± β„­ 𝔉 r⦇ArrCod⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  unfolding ntcf_Yoneda_arrow_def arr_field_simps
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda ntcf_Yoneda_arrow_components(1)
  |vsv ntcf_Yoneda_arrow_vsv[cat_cs_intros]|
  |vdomain ntcf_Yoneda_arrow_vdomain[cat_cs_simps]|

context category
begin

context
  fixes 𝔉 :: V
begin

mk_VLambda ntcf_Yoneda_arrow_components(1)[where Ξ±=Ξ± and β„­=β„­ and 𝔉=β€Ήcf_map 𝔉›]
  |app ntcf_Yoneda_arrow_app'|

lemmas ntcf_Yoneda_arrow_app =
  ntcf_Yoneda_arrow_app'[unfolded in_Hom_iff, cat_cs_simps]

end

end

lemmas [cat_cs_simps] = category.ntcf_Yoneda_arrow_app


subsubsectionβ€ΉSeveral technical lemmasβ€Ί

lemma (in vsv) vsv_vrange_VLambda_app:
  assumes "g ` elts A = elts (π’Ÿβˆ˜ r)"
  shows "β„›βˆ˜ (Ξ»x∈∘A. r⦇g x⦈) = β„›βˆ˜ r"
proof(intro vsubset_antisym vsv.vsv_vrange_vsubset, unfold vdomain_VLambda)
  show "(Ξ»x∈∘A. r⦇g x⦈)⦇x⦈ ∈∘ β„›βˆ˜ r" if "x ∈∘ A" for x
  proof-
    from assms that have "g x ∈∘ π’Ÿβˆ˜ r" by auto
    then have "r⦇g x⦈ ∈∘ β„›βˆ˜ r" by force
    with that show ?thesis by simp
  qed
  show "r⦇x⦈ ∈∘ β„›βˆ˜ (Ξ»x∈∘A. r⦇g x⦈)" if "x ∈∘ π’Ÿβˆ˜ r" for x
  proof-
    from that assms have "x ∈ g ` elts A" by simp
    then obtain c where c: "c ∈∘ A" and x_def: "x = g c" by clarsimp
    from c show ?thesis unfolding x_def by auto
  qed
qed auto

lemma (in vsv) vsv_vrange_VLambda_app':
  assumes "g ` elts A = elts (π’Ÿβˆ˜ r)"
    and "R = β„›βˆ˜ r"
  shows "β„›βˆ˜ (Ξ»x∈∘A. r⦇g x⦈) = R"
  using assms(1) unfolding assms(2) by (rule vsv_vrange_VLambda_app)

lemma (in v11) v11_VLambda_v11_bij_betw_comp:
  assumes "bij_betw g (elts A) (elts (π’Ÿβˆ˜ r))"
  shows "v11 (Ξ»x∈∘A. r⦇g x⦈)"
proof(rule vsv.vsv_valeq_v11I, unfold vdomain_VLambda beta)
  fix x y assume prems: "x ∈∘ A" "y ∈∘ A" "r⦇g x⦈ = r⦇g y⦈"
  from assms prems(1,2) have "g x ∈∘ π’Ÿβˆ˜ r" and "g y ∈∘ π’Ÿβˆ˜ r" by auto
  from v11_injective[OF this prems(3)] have "g x = g y".
  with assms prems(1,2) show "x = y" unfolding bij_betw_def inj_on_def by simp
qed simp


subsubsectionβ€Ή
Yoneda natural transformation arrow is an arrow in the category β€ΉSetβ€Ί
β€Ί

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "𝔉 : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r :
    Hom 
      (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
      (cf_map (HomO.CΞ±β„­(r,-)))
      (cf_map 𝔉) ↦isocat_Set Ξ²
    𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
proof-

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔉: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 by (rule assms)

  from assms(2) interpret FUNCT: tiny_category Ξ² β€Ήcat_FUNCT Ξ± β„­ (cat_Set Ξ±)β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

  let ?Hom_r = β€ΉHomO.CΞ±β„­(r,-)β€Ί

  from assms have [cat_cs_simps]: "cf_of_cf_map β„­ (cat_Set Ξ±) (cf_map 𝔉) = 𝔉"
    by (cs_concl cs_simp: cat_FUNCT_cs_simps)

  note Yoneda = cat_Yoneda_Lemma[OF assms(3,4)]

  show ?thesis
  proof
    (
      intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI,
      unfold cat_cs_simps cf_map_components
    )
    show "vfsequence (ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r)"
      unfolding ntcf_Yoneda_arrow_def by simp
    show "vcard (ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r) = 3β„•"
      unfolding ntcf_Yoneda_arrow_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r⦇ArrVal⦈) = 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
      unfolding cat_cs_simps cf_map_components ntcf_Yoneda_arrow_components 
      by (intro vsv.vsv_vrange_VLambda_app', unfold Yoneda(2))
        (
          use assms(4) in
            β€Ή
              cs_concl
                cs_simp:
                  cat_cs_simps bij_betwD(2)[OF bij_betw_ntcf_of_ntcf_arrow_Hom]
                cs_intro: cat_cs_intros
            β€Ί
        )+
    then show "β„›βˆ˜ (ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r⦇ArrVal⦈) βŠ†βˆ˜ 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
      by auto
    from assms(4) show "v11 (ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r⦇ArrVal⦈)"
      unfolding ntcf_Yoneda_arrow_components
      by 
        (
          intro v11.v11_VLambda_v11_bij_betw_comp, 
          unfold cat_cs_simps 𝔉.Yoneda_map_vdomain; 
          intro Yoneda bij_betw_ntcf_of_ntcf_arrow_Hom
        )
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(4) show 
      "Hom (cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) (cf_map ?Hom_r) (cf_map 𝔉) ∈∘ Vset Ξ²"
      by (intro FUNCT.cat_Hom_in_Vset)
        (
          cs_concl 
            cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    from assms(4) have "𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ∈∘ Vset Ξ±" 
      by (cs_concl cs_intro: cat_cs_intros)
    then show "𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ∈∘ Vset Ξ²"
      by (auto simp: assms(2) Vset_trans Vset_in_mono)
  qed (auto intro: cat_cs_intros)

qed

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism':
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "𝔉' = cf_map 𝔉"
    and "B = 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
    and "A = Hom 
      (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
      (cf_map (HomO.CΞ±β„­(r,-)))
      (cf_map 𝔉)"
    and "𝔉 : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow Ξ± β„­ 𝔉' r : A ↦isocat_Set Ξ² B"
  using assms(1,2,6,7) 
  unfolding assms(3-5)
  by (rule cat_ntcf_Yoneda_arrow_is_arr_isomoprhism)

lemmas [cat_arrow_cs_intros] = 
  category.cat_ntcf_Yoneda_arrow_is_arr_isomoprhism'

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "𝔉 : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r :
    Hom
      (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
      (cf_map (HomO.CΞ±β„­(r,-)))
      (cf_map 𝔉) ↦cat_Set Ξ²
    𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  by 
    (
      rule cat_Set_is_arr_isomorphismD[
        OF cat_ntcf_Yoneda_arrow_is_arr_isomoprhism[OF assms]
        ]
    )

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr'[cat_cs_intros]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "𝔉' = cf_map 𝔉"
    and "B = 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
    and "A = Hom 
      (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
      (cf_map (HomO.CΞ±β„­(r,-)))
      (cf_map 𝔉)"
    and "𝔉 : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow Ξ± β„­ 𝔉' r : A ↦cat_Set Ξ² B"
  using assms(1,2,6,7) 
  unfolding assms(3-5)
  by (rule cat_ntcf_Yoneda_arrow_is_arr)

lemmas [cat_arrow_cs_intros] = category.cat_ntcf_Yoneda_arrow_is_arr'


subsectionβ€ΉCommutativity law for the Yoneda natural transformation arrowβ€Ί

lemma (in category) cat_ntcf_Yoneda_arrow_commutativity:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "𝔑 : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "f : a ↦ℭ b" 
  shows 
    "ntcf_Yoneda_arrow Ξ± β„­ (cf_map π”Š) b ∘Acat_Set Ξ²
      cf_hom
        (cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) 
        [ntcf_arrow HomA.CΞ±β„­(f,-), ntcf_arrow 𝔑]∘ =
          cf_eval_arrow β„­ (ntcf_arrow 𝔑) f ∘Acat_Set Ξ²
            ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) a"
proof-

  let ?hom = 
    β€Ή
      cf_hom
        (cat_FUNCT Ξ± β„­ (cat_Set Ξ±)) 
        [ntcf_arrow HomA.CΞ±β„­(f,-), ntcf_arrow 𝔑]∘
    β€Ί

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔑: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 π”Š 𝔑 by (rule assms(3))
  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)
  interpret Ξ²β„­: category Ξ² β„­
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret cat_Set_Ξ±Ξ²: subcategory Ξ² β€Ήcat_Set Ξ±β€Ί β€Ήcat_Set Ξ²β€Ί
    by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])

  from assms(2,4) have π”Šb_𝔑f:
    "ntcf_Yoneda_arrow Ξ± β„­ (cf_map π”Š) b ∘Acat_Set Ξ² ?hom :
      Hom
        (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
        (cf_map (HomO.CΞ±β„­(a,-)))
        (cf_map 𝔉) ↦cat_Set Ξ²
      π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    by
      (
        cs_concl
          cs_intro:
            cat_small_cs_intros
            cat_cs_intros
            cat_prod_cs_intros
            cat_op_intros
            cat_FUNCT_cs_intros
      )

  from assms(2,4) have 𝔑f_𝔉a:
    "cf_eval_arrow β„­ (ntcf_arrow 𝔑) f ∘Acat_Set Ξ²
      ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) a :
      Hom
        (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
        (cf_map (HomO.CΞ±β„­(a,-)))
        (cf_map 𝔉) ↦cat_Set Ξ²
      π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    by (cs_concl cs_intro: cat_cs_intros cat_Set_Ξ±Ξ².subcat_is_arrD)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ²])

    from π”Šb_𝔑f show arr_Set_π”Šb_𝔑f:
      "arr_Set Ξ² (ntcf_Yoneda_arrow Ξ± β„­ (cf_map π”Š) b ∘Acat_Set Ξ² ?hom)"
      by (auto dest: cat_Set_is_arrD(1))
    from π”Šb_𝔑f have dom_lhs: 
      "π’Ÿβˆ˜ ((ntcf_Yoneda_arrow Ξ± β„­ (cf_map π”Š) b ∘Acat_Set Ξ² ?hom)⦇ArrVal⦈) = 
        Hom
          (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
          (cf_map (HomO.CΞ±β„­(a,-)))
          (cf_map 𝔉)"
      by (cs_concl cs_simp: cat_cs_simps)+
    interpret 𝔑f_𝔉a: arr_Set 
      Ξ² β€Ήntcf_Yoneda_arrow Ξ± β„­ (cf_map π”Š) b ∘Acat_Set Ξ² ?homβ€Ί
      by (rule arr_Set_π”Šb_𝔑f)
  
    from 𝔑f_𝔉a show arr_Set_𝔑f_𝔉a:
      "arr_Set 
        Ξ² 
        (
          cf_eval_arrow β„­ (ntcf_arrow 𝔑) f ∘Acat_Set Ξ²
          ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) a
        )"
      by (auto dest: cat_Set_is_arrD(1))
    from 𝔑f_𝔉a have dom_rhs: 
      "π’Ÿβˆ˜ 
        (
          (
            cf_eval_arrow β„­ (ntcf_arrow 𝔑) f ∘Acat_Set Ξ²
            ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) a
          )⦇ArrVal⦈
        ) = Hom
          (cat_FUNCT Ξ± β„­ (cat_Set Ξ±))
          (cf_map (HomO.CΞ±β„­(a,-)))
          (cf_map 𝔉)" 
      by (cs_concl cs_simp: cat_cs_simps)

    show 
      "(ntcf_Yoneda_arrow Ξ± β„­ (cf_map π”Š) b ∘Acat_Set Ξ² ?hom)⦇ArrVal⦈ =
        (
          cf_eval_arrow β„­ (ntcf_arrow 𝔑) f ∘Acat_Set Ξ²
          ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) a
        )⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)

      fix 𝔐 assume prems: 
        "𝔐 : cf_map HomO.CΞ±β„­(a,-) ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) cf_map 𝔉"

      from assms(4) have [cat_cs_simps]:
        "cf_of_cf_map β„­ (cat_Set Ξ±) (cf_map HomO.CΞ±β„­(a,-)) = HomO.CΞ±β„­(a,-)"
        "cf_of_cf_map β„­ (cat_Set Ξ±) (cf_map 𝔉) = 𝔉"
        by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)

      note 𝔐 = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]

      interpret 𝔐: is_ntcf 
        Ξ± β„­ β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(a,-)β€Ί 𝔉 β€Ήntcf_of_ntcf_arrow β„­ (cat_Set Ξ±) 𝔐›
        by (rule 𝔐(1))

      have π”Šπ”‘_eq_𝔑𝔉:
        "π”Šβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‘β¦‡NTMapβ¦ˆβ¦‡aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡A⦈⦈ =
          𝔑⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡A⦈⦈"
        if "A ∈∘ 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈" for A      
        using 
          ArrVal_eq_helper[
            OF 𝔑.ntcf_Comp_commute[OF assms(4), symmetric], where a=A
            ]
          assms(4)
          that
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from 𝔐(1) assms(2,3,4) have 𝔐a_CId_a: 
        "𝔐⦇NTMapβ¦ˆβ¦‡aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡a⦈⦈ ∈∘ 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
        by (subst 𝔐)
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
              cs_intro: cat_Set_cs_intros cat_cs_intros
          )

      have 𝔉f_𝔐a_eq_𝔐b:
        "𝔉⦇ArrMapβ¦ˆβ¦‡fβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”β¦‡NTMapβ¦ˆβ¦‡aβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡h⦈⦈ =
          𝔐⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f ∘Aβ„­ h⦈"
        if "h : a ↦ℭ a" for h
        using 
          ArrVal_eq_helper[
            OF 𝔐.ntcf_Comp_commute[OF assms(4), symmetric], where a=h
            ]
          that
          assms(4)
          category_axioms
        by
          (
            cs_prems
              cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
          )
    
      from 𝔐(1) assms(2,3,4) 𝔐a_CId_a category_axioms show 
        "(ntcf_Yoneda_arrow Ξ± β„­ (cf_map π”Š) b ∘Acat_Set Ξ² ?hom)⦇ArrValβ¦ˆβ¦‡π”β¦ˆ =
          (
            cf_eval_arrow β„­ (ntcf_arrow 𝔑) f ∘Acat_Set Ξ²
            ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) a
          )⦇ArrValβ¦ˆβ¦‡π”β¦ˆ" 
        by (subst (1 2) 𝔐(2)) (*very slow*)
          (
            cs_concl
              cs_simp:
                𝔉f_𝔐a_eq_𝔐b π”Šπ”‘_eq_𝔑𝔉
                cat_FUNCT_cs_simps 
                cat_cs_simps 
                cat_op_simps
              cs_intro: 
                cat_Set_Ξ±Ξ².subcat_is_arrD 
                cat_small_cs_intros
                cat_cs_intros 
                cat_FUNCT_cs_intros
                cat_prod_cs_intros
                cat_op_intros
          )+

    qed (use arr_Set_π”Šb_𝔑f arr_Set_𝔑f_𝔉a in auto)

  qed (use π”Šb_𝔑f 𝔑f_𝔉a in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed



subsectionβ€ΉYoneda Lemma: naturalityβ€Ί


subsubsectionβ€Ή
The Yoneda natural transformation: definition and elementary properties
β€Ί


textβ€Ή
The main result of this subsection corresponds to the corollary to the 
Yoneda Lemma on page 61 in \cite{mac_lane_categories_2010}.
β€Ί

definition ntcf_Yoneda :: "V β‡’ V β‡’ V β‡’ V"
  where "ntcf_Yoneda Ξ± Ξ² β„­ =
    [
      (
        λ𝔉r∈∘(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈. 
          ntcf_Yoneda_arrow Ξ± β„­ (𝔉r⦇0⦈) (𝔉r⦇1β„•β¦ˆ)
      ),
      cf_nt Ξ± Ξ² (cf_id β„­),
      cf_eval Ξ± Ξ² β„­,
      cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­,
      cat_Set Ξ²
    ]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_Yoneda_components:
  shows "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMap⦈ =
    (
      λ𝔉r∈∘(cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈.
        ntcf_Yoneda_arrow Ξ± β„­ (𝔉r⦇0⦈) (𝔉r⦇1β„•β¦ˆ)
    )"
    and [cat_cs_simps]: "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTDom⦈ = cf_nt Ξ± Ξ² (cf_id β„­)"
    and [cat_cs_simps]: "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTCod⦈ = cf_eval Ξ± Ξ² β„­"
    and [cat_cs_simps]: 
      "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTDGDom⦈ = cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­"
    and [cat_cs_simps]: "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTDGCod⦈ = cat_Set Ξ²"
  unfolding ntcf_Yoneda_def nt_field_simps by (simp_all add: nat_omega_simps)
    

subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda ntcf_Yoneda_components(1)
  |vsv ntcf_Yoneda_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_Yoneda_NTMap_vdomain[cat_cs_intros]|

lemma (in category) ntcf_Yoneda_NTMap_app[cat_cs_simps]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β" 
    and "𝔉r = [cf_map 𝔉, r]∘"
    and "𝔉 : β„­ ↦↦CΞ± cat_Set Ξ±"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡π”‰r⦈ = ntcf_Yoneda_arrow Ξ± β„­ (cf_map 𝔉) r"
proof-            
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔉: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί 𝔉 by (rule assms(4))
  interpret Ξ²β„­: category Ξ² β„­
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  from assms(2) interpret FUNCT: category Ξ² β€Ήcat_FUNCT Ξ± β„­ (cat_Set Ξ±)β€Ί
    by
      (
        cs_concl cs_intro: 
          cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
  from assms(5) have "[cf_map 𝔉, r]∘ ∈∘ (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈"
    by
      (
        cs_concl 
          cs_simp: cat_FUNCT_cs_simps
          cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
      )
  then show ?thesis
    unfolding assms(3) ntcf_Yoneda_components by (simp add: nat_omega_simps)
qed

lemmas [cat_cs_simps] = category.ntcf_Yoneda_NTMap_app


subsubsectionβ€ΉThe Yoneda natural transformation is a natural transformationβ€Ί

lemma (in category) cat_ntcf_Yoneda_is_ntcf:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" 
  shows "ntcf_Yoneda Ξ± Ξ² β„­ :
    cf_nt Ξ± Ξ² (cf_id β„­) ↦CF.iso cf_eval Ξ± Ξ² β„­ :
    cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ ↦↦CΞ² cat_Set Ξ²"
proof-

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret Ξ²β„­: category Ξ² β„­
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  from assms(2) interpret FUNCT: category Ξ² β€Ήcat_FUNCT Ξ± β„­ (cat_Set Ξ±)β€Ί
    by 
      (
        cs_concl cs_intro: 
          cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )

  show ?thesis
  proof(intro is_iso_ntcfI is_ntcfI')
    show "vfsequence (ntcf_Yoneda Ξ± Ξ² β„­)" unfolding ntcf_Yoneda_def by simp
    show "vcard (ntcf_Yoneda Ξ± Ξ² β„­) = 5β„•"
      unfolding ntcf_Yoneda_def by (simp add: nat_omega_simps)
    show ntcf_Yoneda_𝔉r: "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡π”‰r⦈ :
      cf_nt Ξ± Ξ² (cf_id β„­)⦇ObjMapβ¦ˆβ¦‡π”‰r⦈ ↦isocat_Set Ξ² cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰r⦈"
      if "𝔉r ∈∘ (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈" for 𝔉r
    proof-
      from that obtain 𝔉 r 
        where 𝔉r_def: "𝔉r = [𝔉, r]∘" 
          and 𝔉: "𝔉 ∈∘ cf_maps Ξ± β„­ (cat_Set Ξ±)"
          and r: "r ∈∘ ℭ⦇Obj⦈"
        by
          (
            auto 
              elim: cat_prod_2_ObjE[rotated 2] 
              simp: cat_FUNCT_cs_simps
              intro: cat_cs_intros
           )
      from 𝔉 obtain π”Š
        where 𝔉_def: "𝔉 = cf_map π”Š" and π”Š: "π”Š : β„­ ↦↦CΞ± cat_Set Ξ±"
        by clarsimp
      from assms(2) π”Š r show ?thesis
        unfolding 𝔉r_def 𝔉_def 
        by
          (
            cs_concl! 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
           )      
    qed
    show "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡π”‰r⦈ :
      cf_nt Ξ± Ξ² (cf_id β„­)⦇ObjMapβ¦ˆβ¦‡π”‰r⦈ ↦cat_Set Ξ² cf_eval Ξ± Ξ² ℭ⦇ObjMapβ¦ˆβ¦‡π”‰r⦈"
      if "𝔉r ∈∘ (cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­)⦇Obj⦈" for 𝔉r
      by (rule is_arr_isomorphismD[OF ntcf_Yoneda_𝔉r[OF that]])
    show 
      "ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡π”Šb⦈ ∘Acat_Set Ξ² 
        cf_nt Ξ± Ξ² (cf_id β„­)⦇ArrMapβ¦ˆβ¦‡π”‘f⦈ =
          cf_eval Ξ± Ξ² ℭ⦇ArrMapβ¦ˆβ¦‡π”‘f⦈ ∘Acat_Set Ξ² 
            ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡π”‰a⦈"
      if 𝔑f: "𝔑f : 𝔉a ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) Γ—C β„­ π”Šb" for 𝔉a π”Šb 𝔑f
    proof-
      obtain 𝔑 f 𝔉 a π”Š b
        where 𝔑f_def: "𝔑f = [𝔑, f]∘" 
          and 𝔉a_def: "𝔉a = [𝔉, a]∘"
          and π”Šb_def: "π”Šb = [π”Š, b]∘" 
          and 𝔑: "𝔑 : 𝔉 ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) π”Š" 
          and f: "f : a ↦ℭ b"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔑f] 
              FUNCT.category_axioms 
              Ξ²β„­.category_axioms
          )
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
      note [cat_cs_simps] = 
        cat_ntcf_Yoneda_arrow_commutativity[OF assms 𝔑(1) f, folded 𝔑(2,3,4)]
      from 𝔑(1) assms(2) f show ?thesis
        unfolding 𝔑f_def 𝔉a_def π”Šb_def
        by (subst (1 2) 𝔑(2), use nothing in β€Ήsubst 𝔑(3), subst 𝔑(4)β€Ί)
          (
            cs_concl
              cs_simp: 𝔑(2,3,4)[symmetric] cat_cs_simps cs_intro: cat_cs_intros
          )+
    qed

  qed (use assms(2) in β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβ€Ί)+

qed



subsectionβ€Ήβ€ΉHomβ€Ί-mapβ€Ί

textβ€Ή
This subsection presents some of the results stated as Corollary 2 
in subsection 1.15 in \cite{bodo_categories_1970} and the corollary 
following the statement of the Yoneda Lemma on 
page 61 in \cite{mac_lane_categories_2010} in a variety of forms.
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The following function makes an explicit appearance in subsection 1.15 in 
\cite{bodo_categories_1970}.
β€Ί

definition ntcf_Hom_map :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_Hom_map Ξ± β„­ a b = (Ξ»f∈∘Hom β„­ a b. HomA.CΞ±β„­(f,-))"


textβ€ΉElementary properties.β€Ί

mk_VLambda ntcf_Hom_map_def
  |vsv ntcf_Hom_map_vsv|
  |vdomain ntcf_Hom_map_vdomain[cat_cs_simps]|
  |app ntcf_Hom_map_app[unfolded in_Hom_iff, cat_cs_simps]|


subsubsectionβ€Ήβ€ΉHomβ€Ί-map is a bijectionβ€Ί

lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique:
  ―‹The following lemma approximately corresponds to the corollary on 
page 61 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.CΞ±β„­(r,-) ↦CF HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ : s ↦ℭ r"
    and "𝔑 = HomA.CΞ±β„­(Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ,-)"
    and "β‹€f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.CΞ±β„­(f,-) ⟧ ⟹
      f = Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ"
proof-

  interpret 𝔑: is_ntcf Ξ± β„­ β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(r,-)β€Ί β€ΉHomO.CΞ±β„­(s,-)β€Ί 𝔑
    by (rule assms(3))
  let ?Y_Hom_s = β€ΉYoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ€Ί
  note Yoneda = 
    cat_Yoneda_Lemma[OF cat_cf_Hom_snd_is_functor[OF assms(2)] assms(1)]
  interpret Y: v11 β€Ή?Y_Hom_sβ€Ί by (rule Yoneda(1))

  from category_axioms assms have 𝔑_in_vdomain: "𝔑 ∈∘ π’Ÿβˆ˜ (?Y_Hom_s)" 
    by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros) 
  then have "?Y_Hom_sβ¦‡π”‘β¦ˆ ∈∘ β„›βˆ˜ (?Y_Hom_s)" by (simp add: Y.vsv_vimageI2)
  from this category_axioms assms show Ym_𝔑: "?Y_Hom_sβ¦‡π”‘β¦ˆ : s ↦ℭ r"
    unfolding Yoneda(2) 
    by (cs_prems_step cs_simp: cat_cs_simps cat_op_simps)+ simp
  then have "?Y_Hom_sβ¦‡π”‘β¦ˆ ∈∘ ℭ⦇Arr⦈" by (simp add: cat_cs_intros)

  have "HomA.CΞ±β„­(?Y_Hom_sβ¦‡π”‘β¦ˆ,-) :
    HomO.CΞ±β„­(r,-) ↦CF HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by (intro cat_ntcf_Hom_snd_is_ntcf Ym_𝔑)

  from assms Ym_𝔑 this category_axioms assms have 
    "(?Y_Hom_s)Β―βˆ˜β¦‡?Y_Hom_sβ¦‡π”‘β¦ˆβ¦ˆ =
      Yoneda_arrow Ξ± HomO.CΞ±β„­(s,-) r (?Y_Hom_sβ¦‡π”‘β¦ˆ)"
    by (intro category.inv_Yoneda_map_app)
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros) 
  then have "(?Y_Hom_s)Β―βˆ˜β¦‡?Y_Hom_sβ¦‡π”‘β¦ˆβ¦ˆ = HomA.CΞ±β„­(?Y_Hom_sβ¦‡π”‘β¦ˆ,-)"
    by (simp add: ntcf_Hom_snd_def'[OF Ym_𝔑])
  with 𝔑_in_vdomain show "𝔑 = HomA.CΞ±β„­(?Y_Hom_sβ¦‡π”‘β¦ˆ,-)" by auto

  fix f assume prems: "f ∈∘ ℭ⦇Arr⦈" "𝔑 = HomA.CΞ±β„­(f,-)"
  then obtain a b where f: "f : a ↦ℭ b" by auto

  have "𝔑 : HomO.CΞ±β„­(b,-) ↦CF HomO.CΞ±β„­(a,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by (rule cat_ntcf_Hom_snd_is_ntcf[OF f, folded prems(2)])
  with f 𝔑.ntcf_NTDom 𝔑.ntcf_NTCod assms cat_is_arrD(2,3)[OF f] 
  have ba_simps: "b = r" "a = s"
    by 
      (
        simp_all add: 
          prems(2) cat_cf_Hom_snd_inj cat_ntcf_Hom_snd_components(2,3)
      )
  from f have "f : s ↦ℭ r" unfolding ba_simps .

  with category_axioms show "f = ?Y_Hom_sβ¦‡π”‘β¦ˆ"
    unfolding prems(2) by (cs_concl cs_simp: cat_cs_simps cat_op_simps)

qed

lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique:
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.CΞ±β„­(-,r) ↦CF HomO.CΞ±β„­(-,s) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "Yoneda_map Ξ± HomO.CΞ±β„­(-,s) rβ¦‡π”‘β¦ˆ : r ↦ℭ s"
    and "𝔑 = HomA.CΞ±β„­(-,Yoneda_map Ξ± HomO.CΞ±β„­(-,s) rβ¦‡π”‘β¦ˆ)"
    and "β‹€f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.CΞ±β„­(-,f) ⟧ ⟹
      f = Yoneda_map Ξ± HomO.CΞ±β„­(-,s) rβ¦‡π”‘β¦ˆ"
  by 
    (
      intro  
        category.cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[
          OF category_op, 
          unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd, 
          OF assms(1,2), 
          unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
          OF assms(3)
          ]
    )+

lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique':
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.CΞ±β„­(r,-) ↦CF HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "βˆƒ!f. f ∈∘ ℭ⦇Arr⦈ ∧ 𝔑 = HomA.CΞ±β„­(f,-)"
  using cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms] by blast

lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique':
  assumes "r ∈∘ ℭ⦇Obj⦈"
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.CΞ±β„­(-,r) ↦CF HomO.CΞ±β„­(-,s) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "βˆƒ!f. f ∈∘ ℭ⦇Arr⦈ ∧ 𝔑 = HomA.CΞ±β„­(-,f)"
  using cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique[OF assms] by blast

lemma (in category) cat_ntcf_Hom_snd_inj:
  assumes "HomA.CΞ±β„­(g,-) = HomA.CΞ±β„­(f,-)" 
    and "g : a ↦ℭ b" 
    and "f : a ↦ℭ b" 
  shows "g = f"
proof-
  from assms have 
    "Yoneda_map Ξ± (HomO.CΞ±β„­(a,-)) b⦇HomA.CΞ±β„­(g,-)⦈ =
      Yoneda_map Ξ± (HomO.CΞ±β„­(a,-)) b⦇HomA.CΞ±β„­(f,-)⦈"
    by simp
  from this assms category_axioms show "g = f"
    by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros) 
      simp (*slow*)
qed

lemma (in category) cat_ntcf_Hom_fst_inj:
  assumes "HomA.CΞ±β„­(-,g) = HomA.CΞ±β„­(-,f)" 
    and "g : a ↦ℭ b" 
    and "f : a ↦ℭ b" 
  shows "g = f"
proof-
  from category.cat_ntcf_Hom_snd_inj
    [
      OF category_op, 
      unfolded cat_op_simps,
      unfolded cat_op_cat_ntcf_Hom_snd,
      OF assms
    ]
  show ?thesis .
qed

lemma (in category) cat_ntcf_Hom_map: 
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "v11 (ntcf_Hom_map Ξ± β„­ a b)" 
    and "β„›βˆ˜ (ntcf_Hom_map Ξ± β„­ a b) =
      these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-)"
    and "(ntcf_Hom_map Ξ± β„­ a b)¯∘ =
      (Ξ»π”‘βˆˆβˆ˜these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-).
        Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆ)"
proof-

  show "v11 (ntcf_Hom_map Ξ± β„­ a b)"
  proof(rule vsv.vsv_valeq_v11I, unfold ntcf_Hom_map_vdomain in_Hom_iff)
    show "vsv (ntcf_Hom_map Ξ± β„­ a b)" unfolding ntcf_Hom_map_def by simp
    fix g f assume prems: 
      "g : a ↦ℭ b" 
      "f : a ↦ℭ b"
      "ntcf_Hom_map Ξ± β„­ a b⦇g⦈ = ntcf_Hom_map Ξ± β„­ a b⦇f⦈"
    from prems(3,1,2) have "HomA.CΞ±β„­(g,-) = HomA.CΞ±β„­(f,-)"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    with prems(1,2) show "g = f" by (intro cat_ntcf_Hom_snd_inj[of g f])
  qed
  then interpret Hm: v11 β€Ήntcf_Hom_map Ξ± β„­ a bβ€Ί .

  show Hm_vrange: "β„›βˆ˜ (ntcf_Hom_map Ξ± β„­ a b) =
    these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-)"
  proof(intro vsubset_antisym)
    show "β„›βˆ˜ (ntcf_Hom_map Ξ± β„­ a b) βŠ†βˆ˜
      these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-)"
      by 
        (
          unfold ntcf_Hom_map_def,
          intro vrange_VLambda_vsubset, 
          unfold these_ntcfs_iff in_Hom_iff, 
          intro cat_ntcf_Hom_snd_is_ntcf
        )
    show "these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-) βŠ†βˆ˜
      β„›βˆ˜ (ntcf_Hom_map Ξ± β„­ a b)"
    proof(intro vsubsetI, unfold these_ntcfs_iff)
      fix 𝔑 assume prems: 
        "𝔑 : HomO.CΞ±β„­(b,-) ↦CF HomO.CΞ±β„­(a,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
      note unique = 
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
      from unique(1) have 
        "Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆ ∈∘ π’Ÿβˆ˜ (ntcf_Hom_map Ξ± β„­ a b)"
        by (cs_concl cs_simp: cat_cs_simps)
      moreover from 
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF assms(2,1) prems] 
      have 𝔑_def: "𝔑 = ntcf_Hom_map Ξ± β„­ a b⦇Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆβ¦ˆ"
        by (cs_concl cs_simp: cat_cs_simps)
      ultimately show "𝔑 ∈∘ β„›βˆ˜ (ntcf_Hom_map Ξ± β„­ a b)" by force
    qed 
  qed

  show "(ntcf_Hom_map Ξ± β„­ a b)¯∘ =
    (
      Ξ»π”‘βˆˆβˆ˜these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-).
        Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆ
    )"
  proof
    (
      rule vsv_eqI, 
      unfold vdomain_vconverse vdomain_VLambda Hm_vrange these_ntcfs_iff
    )

    from Hm.v11_axioms show "vsv ((ntcf_Hom_map Ξ± β„­ a b)¯∘)" by auto
    show "vsv 
      (
        Ξ»π”‘βˆˆβˆ˜these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-).
          Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆ
      )"
      by simp

    fix 𝔑 assume prems: 
      "𝔑 : HomO.CΞ±β„­(b,-) ↦CF HomO.CΞ±β„­(a,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    then have 𝔑: 
      "𝔑 ∈∘ these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-)"
      unfolding these_ntcfs_iff by simp
    show "(ntcf_Hom_map Ξ± β„­ a b)Β―βˆ˜β¦‡π”‘β¦ˆ =
      (
        Ξ»π”‘βˆˆβˆ˜these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-).
          Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆ
      )β¦‡π”‘β¦ˆ"
    proof
      (
        intro Hm.v11_vconverse_app, 
        unfold ntcf_Hom_map_vdomain in_Hom_iff beta[OF 𝔑]
      )
      note unique = 
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
      show "Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆ : a ↦ℭ b" by (rule unique(1))
      then show 
        "ntcf_Hom_map Ξ± β„­ a b⦇Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆβ¦ˆ = 𝔑"
        by (cs_concl cs_simp: unique(2)[symmetric] cat_cs_simps)
    qed

  qed simp

qed


subsubsectionβ€ΉInverse of a β€ΉHomβ€Ί-mapβ€Ί

lemma (in category) inv_ntcf_Hom_map_v11: 
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "v11 ((ntcf_Hom_map Ξ± β„­ a b)¯∘)"
  using cat_ntcf_Hom_map(1)[OF assms] by (simp add: v11.v11_vconverse)

lemma (in category) inv_ntcf_Hom_map_vdomain: 
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "π’Ÿβˆ˜ ((ntcf_Hom_map Ξ± β„­ a b)¯∘) =
    these_ntcfs Ξ± β„­ (cat_Set Ξ±) HomO.CΞ±β„­(b,-) HomO.CΞ±β„­(a,-)"
  unfolding cat_ntcf_Hom_map(3)[OF assms] by simp

lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_vdomain

lemma (in category) inv_ntcf_Hom_map_app: 
  assumes "a ∈∘ ℭ⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.CΞ±β„­(b,-) ↦CF HomO.CΞ±β„­(a,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "(ntcf_Hom_map Ξ± β„­ a b)Β―βˆ˜β¦‡π”‘β¦ˆ = Yoneda_map Ξ± HomO.CΞ±β„­(a,-) bβ¦‡π”‘β¦ˆ"
  using assms(3) unfolding cat_ntcf_Hom_map(3)[OF assms(1,2)] by simp

lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_app

lemma inv_ntcf_Hom_map_vrange: "β„›βˆ˜ ((ntcf_Hom_map Ξ± β„­ a b)¯∘) = Hom β„­ a b"
  unfolding ntcf_Hom_map_def by simp


subsubsectionβ€Ήβ€ΉHomβ€Ί-natural transformation and isomorphismsβ€Ί


textβ€Ή
This subsection presents further results that were stated 
as Corollary 2 in subsection 1.15 in \cite{bodo_categories_1970}.
β€Ί

lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf:
  assumes "f : s ↦isoβ„­ r"
  shows "HomA.CΞ±β„­(f,-) :
    HomO.CΞ±β„­(r,-) ↦CF.iso HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  from assms obtain g 
    where iso_g: "g : r ↦isoβ„­ s" 
      and gf: "g ∘Aβ„­ f = ℭ⦇CIdβ¦ˆβ¦‡s⦈"
      and fg: "f ∘Aβ„­ g = ℭ⦇CIdβ¦ˆβ¦‡r⦈"
    by 
      (
        auto intro:
          cat_the_inverse_Comp_CId_left 
          cat_the_inverse_Comp_CId_right 
          cat_the_inverse_is_arr_isomorphism'
      )
  then have g: "g : r ↦ℭ s" by auto
  show ?thesis
  proof(intro is_arr_isomorphism_is_iso_ntcf)
    from assms have f: "f : s ↦ℭ r" by auto
    with category_axioms show "HomA.CΞ±β„­(f,-) :
      HomO.CΞ±β„­(r,-) ↦CF HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros) 
    from category_axioms g show "HomA.CΞ±β„­(g,-) :
      HomO.CΞ±β„­(s,-) ↦CF HomO.CΞ±β„­(r,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)    
    from category_axioms f g have 
      "HomA.CΞ±β„­(f,-) βˆ™NTCF HomA.CΞ±β„­(g,-) = HomA.CΞ±β„­(g ∘Aβ„­ f,-)"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    also from category_axioms f g have "… = ntcf_id HomO.CΞ±β„­(s,-)"
      by (cs_concl cs_simp: gf cat_cs_simps cs_intro: cat_cs_intros)
    finally show 
      "HomA.CΞ±β„­(f,-) βˆ™NTCF HomA.CΞ±β„­(g,-) = ntcf_id HomO.CΞ±β„­(s,-)"
      by simp
    from category_axioms f g have 
      "HomA.CΞ±β„­(g,-) βˆ™NTCF HomA.CΞ±β„­(f,-) = HomA.CΞ±β„­(f ∘Aβ„­ g,-)"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    also from category_axioms f g have "… = ntcf_id HomO.CΞ±β„­(r,-)"
      by (cs_concl cs_simp: fg cat_cs_simps cs_intro: cat_cs_intros)
    finally show 
      "HomA.CΞ±β„­(g,-) βˆ™NTCF HomA.CΞ±β„­(f,-) = ntcf_id HomO.CΞ±β„­(r,-)"
      by simp
  qed
qed

lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_fst_is_iso_ntcf:
  assumes "f : r ↦isoβ„­ s"
  shows "HomA.CΞ±β„­(-,f) :
    HomO.CΞ±β„­(-,r) ↦CF.iso HomO.CΞ±β„­(-,s) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  from assms have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  from 
    category.cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf
      [
        OF category_op, 
        unfolded cat_op_simps,
        OF assms,
        unfolded
          category.cat_op_cat_cf_Hom_snd[OF category_axioms r]
          category.cat_op_cat_cf_Hom_snd[OF category_axioms s]
          category.cat_op_cat_ntcf_Hom_snd[OF category_axioms]
      ]
  show ?thesis.
qed

lemma (in category) cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique:
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.CΞ±β„­(r,-) ↦CF.iso HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ : s ↦isoβ„­ r"
    and "𝔑 = HomA.CΞ±β„­(Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ,-)"
    and "β‹€f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.CΞ±β„­(f,-) ⟧ ⟹
      f = Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ"
proof-

  let ?Ym_𝔑 = β€ΉYoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆβ€Ί
    and ?Ym_inv_𝔑 = β€ΉYoneda_map Ξ± HomO.CΞ±β„­(r,-) s⦇inv_ntcf π”‘β¦ˆβ€Ί

  from assms(3) have 𝔑:
    "𝔑 : HomO.CΞ±β„­(r,-) ↦CF HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by auto
  from iso_ntcf_is_arr_isomorphism[OF assms(3)] 
  have iso_inv_𝔑: "inv_ntcf 𝔑 : 
    HomO.CΞ±β„­(s,-) ↦CF.iso HomO.CΞ±β„­(r,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    and [simp]: "𝔑 βˆ™NTCF inv_ntcf 𝔑 = ntcf_id HomO.CΞ±β„­(s,-)"
    and [simp]: "inv_ntcf 𝔑 βˆ™NTCF 𝔑 = ntcf_id HomO.CΞ±β„­(r,-)"
    by auto
  from iso_inv_𝔑 have inv_𝔑: 
    "inv_ntcf 𝔑 : HomO.CΞ±β„­(s,-) ↦CF HomO.CΞ±β„­(r,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
    by auto 
  note unique = cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(1,2) 𝔑]
    and inv_unique = 
    cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) inv_𝔑]
  have Ym_𝔑: "?Ym_𝔑 : s ↦ℭ r" by (rule unique(1))

  show "𝔑 = HomA.CΞ±β„­(Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ,-)"
    and "β‹€f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.CΞ±β„­(f,-) ⟧ ⟹
      f = Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ"
    by (intro unique)+

  show "Yoneda_map Ξ± HomO.CΞ±β„­(s,-) rβ¦‡π”‘β¦ˆ : s ↦isoβ„­ r"
  proof(intro is_arr_isomorphismI[OF Ym_𝔑, of β€Ή?Ym_inv_𝔑›] is_inverseI)

    show Ym_inv_𝔑: "?Ym_inv_𝔑 : r ↦ℭ s" by (rule inv_unique(1))
    
    have "ntcf_id HomO.CΞ±β„­(s,-) = 𝔑 βˆ™NTCF inv_ntcf 𝔑" by simp
    also have "… = HomA.CΞ±β„­(?Ym_𝔑,-) βˆ™NTCF HomA.CΞ±β„­(?Ym_inv_𝔑,-)"
      by (subst unique(2), subst inv_unique(2)) simp
    also from category_axioms Ym_𝔑 inv_unique(1) assms(3) have 
      "… = HomA.CΞ±β„­(?Ym_inv_𝔑 ∘Aβ„­ ?Ym_𝔑,-)"
      by (cs_concl cs_simp: cat_cs_simps)
    finally have "HomA.CΞ±β„­(?Ym_inv_𝔑 ∘Aβ„­ ?Ym_𝔑,-) = ntcf_id HomO.CΞ±β„­(s,-)"
      by simp
    also from category_axioms assms(1,2) have "… = HomA.CΞ±β„­(ℭ⦇CIdβ¦ˆβ¦‡s⦈,-)"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    finally have "HomA.CΞ±β„­(?Ym_inv_𝔑 ∘Aβ„­ ?Ym_𝔑,-) = HomA.CΞ±β„­(ℭ⦇CIdβ¦ˆβ¦‡s⦈,-)"
      by simp
    then show "?Ym_inv_𝔑 ∘Aβ„­ ?Ym_𝔑 = ℭ⦇CIdβ¦ˆβ¦‡s⦈"
      by (rule cat_ntcf_Hom_snd_inj)
        (
          allβ€Ή
            use category_axioms Ym_𝔑 Ym_inv_𝔑 assms in 
              β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβ€Ί
            β€Ί
        )
    have "ntcf_id HomO.CΞ±β„­(r,-) = inv_ntcf 𝔑 βˆ™NTCF 𝔑" by simp
    also have "… = HomA.CΞ±β„­(?Ym_inv_𝔑,-) βˆ™NTCF HomA.CΞ±β„­(?Ym_𝔑,-)"
      by (subst unique(2), subst inv_unique(2)) simp
    also from category_axioms Ym_𝔑 inv_unique(1) have 
      "… = HomA.CΞ±β„­(?Ym_𝔑 ∘Aβ„­ ?Ym_inv_𝔑,-)"
      by (cs_concl cs_simp: cat_cs_simps)
    finally have 
      "HomA.CΞ±β„­(?Ym_𝔑 ∘Aβ„­ ?Ym_inv_𝔑,-) = ntcf_id HomO.CΞ±β„­(r,-)"
      by simp
    also from category_axioms assms(1,2) have "… = HomA.CΞ±β„­(ℭ⦇CIdβ¦ˆβ¦‡r⦈,-)"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    finally have 
      "HomA.CΞ±β„­(?Ym_𝔑 ∘Aβ„­ ?Ym_inv_𝔑,-) = HomA.CΞ±β„­(ℭ⦇CIdβ¦ˆβ¦‡r⦈,-)"
      by simp
    then show "?Ym_𝔑 ∘Aβ„­ ?Ym_inv_𝔑 = ℭ⦇CIdβ¦ˆβ¦‡r⦈"
      by (rule cat_ntcf_Hom_snd_inj)
        (
          allβ€Ή
            use category_axioms Ym_𝔑 Ym_inv_𝔑 assms in 
              β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβ€Ί
            β€Ί
        )

  qed (intro Ym_𝔑)

qed

lemma (in category) cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique:
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : 
    HomO.CΞ±β„­(-,r) ↦CF.iso HomO.CΞ±β„­(-,s) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "Yoneda_map Ξ± HomO.CΞ±β„­(-,s) rβ¦‡π”‘β¦ˆ : r ↦isoβ„­ s"
    and "𝔑 = HomA.CΞ±β„­(-,Yoneda_map Ξ± HomO.CΞ±β„­(-,s) rβ¦‡π”‘β¦ˆ)"
    and "β‹€f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.CΞ±β„­(-,f) ⟧ ⟹
      f = Yoneda_map Ξ± HomO.CΞ±β„­(-,s) rβ¦‡π”‘β¦ˆ"
  by 
    (
      intro  
        category.cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[
          OF category_op, 
          unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd, 
          OF assms(1,2), 
          unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
          OF assms(3)
          ]
    )+

lemma (in category) cat_is_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf:
  assumes "f : s ↦ℭ r"
    and "HomA.CΞ±β„­(f,-) :
      HomO.CΞ±β„­(r,-) ↦CF.iso HomO.CΞ±β„­(s,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "f : s ↦isoβ„­ r"
proof-
  from assms(1) have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  note unique = cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[OF r s assms(2)]
  from unique(1) have Ym_Hf: 
    "Yoneda_map Ξ± HomO.CΞ±β„­(s,-) r⦇HomA.CΞ±β„­(f,-)⦈ : s ↦ℭ r"
    by auto
  from unique(1) show ?thesis
    unfolding cat_ntcf_Hom_snd_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
    by simp
qed

lemma (in category) cat_is_arr_isomorphism_if_ntcf_Hom_fst_is_iso_ntcf:
  assumes "f : r ↦ℭ s"
    and "HomA.CΞ±β„­(-,f) :
      HomO.CΞ±β„­(-,r) ↦CF.iso HomO.CΞ±β„­(-,s) : op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "f : r ↦isoβ„­ s"
proof-
  from assms(1) have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  note unique = cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique[OF r s assms(2)]
  from unique(1) have Ym_Hf: 
    "Yoneda_map Ξ± HomO.CΞ±β„­(-,s) r⦇HomA.CΞ±β„­(-,f)⦈ : r ↦ℭ s"
    by auto
  from unique(1) show ?thesis
    unfolding cat_ntcf_Hom_fst_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
    by simp
qed


subsubsectionβ€Ή
The relationship between a β€ΉHomβ€Ί-natural transformation and the compositions 
of a β€ΉHomβ€Ί-natural transformation and a natural transformation
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "HomA.CΞ±(Ο†-,-)⦇NTMapβ¦ˆβ¦‡b, cβ¦ˆβˆ™ = HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMapβ¦ˆβ¦‡c⦈"
proof-      
  interpret Ο†: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from assms(2) have b: "b ∈∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by simp
  from category_axioms assms(1,3) b show ?thesis
    by 
      (
        cs_concl 
          cs_simp: 
            cat_ntcf_lcomp_Hom_component_is_Yoneda_component cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app

lemma (in category) cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomA.CΞ±(Ο†-,-)op_cat 𝔅,β„­(b,-)NTCF = HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-)"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š Ο† by (rule assms(1))  
  show ?thesis
  proof(rule ntcf_eqI[of Ξ±])
    from category_axioms assms show 
      "HomA.CΞ±(Ο†-,-)op_cat 𝔅,β„­(b,-)NTCF : 
      HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) : 
      β„­ ↦↦CΞ± cat_Set Ξ±"      
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
    from assms this have dom_lhs:
      "π’Ÿβˆ˜ ((HomA.CΞ±(Ο†-,-)op_cat 𝔅,β„­(b,-)NTCF)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from category_axioms assms show 
      "HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-) :
        HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) :
        β„­ ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms this have dom_rhs: 
      "π’Ÿβˆ˜ (HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show 
      "(HomA.CΞ±(Ο†-,-)op_cat 𝔅,β„­(b,-)NTCF)⦇NTMap⦈ = 
        HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ ℭ⦇Obj⦈"
      with category_axioms assms show
        "(HomA.CΞ±(Ο†-,-)op_cat 𝔅,β„­(b,-)NTCF)⦇NTMapβ¦ˆβ¦‡a⦈ =
          HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMapβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: cat_cs_simps) 
    qed (use assms(2) in β€Ήauto intro: cat_cs_introsβ€Ί)
  qed simp_all
qed

lemmas [cat_cs_simps] = category.cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd


subsubsectionβ€Ή
The relationship between the β€ΉHomβ€Ί-natural isomorphisms and the compositions
of a β€ΉHomβ€Ί-natural isomorphism and a natural transformation
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "β‹€b. b ∈∘ 𝔅⦇Obj⦈ ⟹ HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-) :
      HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF.iso HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) :
      β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "HomA.CΞ±(Ο†-,-) :
    HomO.CΞ±β„­(π”Š-,-) ↦CF.iso HomO.CΞ±β„­(𝔉-,-) :
    op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  have "HomA.CΞ±(Ο†-,-)op_cat 𝔅,β„­(b,-)NTCF : 
    HomO.CΞ±β„­(π”Š-,-)op_cat 𝔅,β„­(b,-)CF ↦CF.iso 
    HomO.CΞ±β„­(𝔉-,-)op_cat 𝔅,β„­(b,-)CF : 
    β„­ ↦↦CΞ± cat_Set Ξ±"
    if "b ∈∘ 𝔅⦇Obj⦈" for b
    unfolding 
      cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1) that]
      cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο†.NTDom.is_functor_axioms that]
      cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο†.NTCod.is_functor_axioms that]
    by (intro assms(2) that)
  from 
    is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
      OF 
        Ο†.NTDom.HomDom.category_op category_axioms 
        cat_ntcf_lcomp_Hom_is_ntcf[OF assms(1)], 
      unfolded cat_op_simps, OF this
      ]
  show ?thesis .
qed

lemma (in category) cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf:
  assumes "Ο† : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    and "HomA.CΞ±(Ο†-,-) :
      HomO.CΞ±β„­(π”Š-,-) ↦CF.iso HomO.CΞ±β„­(𝔉-,-) :
      op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-) :
    HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF.iso HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) :
    β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  interpret Ο†: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  from category_axioms assms show ?thesis
    by  
      (
        fold 
          cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1,3)]
          cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο†.NTDom.is_functor_axioms assms(3)]
          cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο†.NTCod.is_functor_axioms assms(3)],
        intro bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf
      )    
      (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed



subsectionβ€ΉYoneda map for arbitrary functorsβ€Ί


textβ€Ή
The concept of the Yoneda map for arbitrary functors was developed based
on the function that was used in the statement of Lemma 3 in 
subsection 1.15 in \cite{bodo_categories_1970}.
β€Ί

definition af_Yoneda_map :: "V β‡’ V β‡’ V β‡’ V"
  where "af_Yoneda_map Ξ± 𝔉 π”Š =
    (Ξ»Ο†βˆˆβˆ˜these_ntcfs Ξ± (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈) 𝔉 π”Š. HomA.CΞ±(Ο†-,-))"


textβ€ΉElementary properties.β€Ί

context
  fixes Ξ± 𝔅 β„­ 𝔉 π”Š
  assumes 𝔉: "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and π”Š: "π”Š : 𝔅 ↦↦CΞ± β„­"
begin

interpretation 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule 𝔉)
interpretation π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule π”Š)

mk_VLambda 
  af_Yoneda_map_def[where 𝔉=𝔉 and π”Š=π”Š, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
  |vsv af_Yoneda_map_vsv|
  |vdomain af_Yoneda_map_vdomain[cat_cs_simps]|
  |app af_Yoneda_map_app[unfolded these_ntcfs_iff, cat_cs_simps]|

end



subsectionβ€ΉYoneda arrow for arbitrary functorsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The following natural transformation is used in the proof of Lemma 3 in 
subsection 1.15 in \cite{bodo_categories_1970}.
β€Ί

definition af_Yoneda_arrow :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑 =
    [
      (
        Ξ»b∈∘(𝔉⦇HomDom⦈)⦇Obj⦈.
          Yoneda_map Ξ± HomO.Cα𝔉⦇HomCod⦈(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)⦇
            𝔑op_cat (𝔉⦇HomDom⦈),𝔉⦇HomCod⦈(b,-)NTCF
            ⦈
      ),
      𝔉,
      π”Š,
      𝔉⦇HomDom⦈,
      𝔉⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma af_Yoneda_arrow_components:
  shows "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTMap⦈ =
      (
        Ξ»bβˆˆβˆ˜π”‰β¦‡HomDomβ¦ˆβ¦‡Obj⦈.
          Yoneda_map Ξ± HomO.Cα𝔉⦇HomCod⦈(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)⦇
            𝔑op_cat (𝔉⦇HomDom⦈),𝔉⦇HomCod⦈(b,-)NTCF
            ⦈
      )"
    and "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTDom⦈ = 𝔉"
    and "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTCod⦈ = π”Š"
    and "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTDGDom⦈ = 𝔉⦇HomDom⦈"
    and "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTDGCod⦈ = 𝔉⦇HomCod⦈"
  unfolding af_Yoneda_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda af_Yoneda_arrow_components(1)
  |vsv af_Yoneda_arrow_NTMap_vsv|

context
  fixes Ξ± 𝔅 β„­ 𝔉
  assumes 𝔉: "𝔉 : 𝔅 ↦↦CΞ± β„­"
begin

interpretation 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule 𝔉)

mk_VLambda 
  af_Yoneda_arrow_components(1)[where 𝔉=𝔉, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
  |vdomain af_Yoneda_arrow_NTMap_vdomain[cat_cs_simps]|
  |app af_Yoneda_arrow_NTMap_app[cat_cs_simps]|

end

lemma (in category) cat_af_Yoneda_arrow_is_ntcf:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 :
      HomO.CΞ±β„­(π”Š-,-) ↦CF HomO.CΞ±β„­(𝔉-,-) :
      op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
proof-

  let ?Hπ”Š = β€ΉHomO.CΞ±β„­(π”Š-,-)β€Ί
    and ?H𝔉 = β€ΉHomO.CΞ±β„­(𝔉-,-)β€Ί
    and ?Set = β€Ήcat_Set Ξ±β€Ί
    and ?Ym = 
      β€Ή
        Ξ»b. Yoneda_map
          Ξ± HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)⦇𝔑op_cat 𝔅,β„­(b,-)NTCF⦈
      β€Ί

  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))
  interpret 𝔑: is_ntcf 
    Ξ± β€Ήop_cat 𝔅 Γ—C β„­β€Ί β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(π”Š-,-)β€Ί β€ΉHomO.CΞ±β„­(𝔉-,-)β€Ί 𝔑 
    by (rule assms)

  have comm[unfolded cat_op_simps]:
    "(𝔑⦇NTMap⦈ ⦇c, dβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f ∘Aβ„­ (q ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈)⦈ =
      f ∘Aβ„­ ((𝔑⦇NTMap⦈ ⦇a, bβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡q⦈ ∘Aβ„­ 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈)"
    if "g : a ↦op_cat 𝔅 c" and "f : b ↦ℭ d" and "q : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ b" 
    for q g f a b c d
  proof-
    from that(1) have g: "g : c ↦𝔅 a" unfolding cat_op_simps by simp
    from category_axioms assms g that(2) have ab:
      "[a, b]∘ ∈∘ (op_cat 𝔅 Γ—C β„­)⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
    from 𝔑.ntcf_NTMap_is_arr[OF ab] category_axioms assms g that(2) have 𝔑ab: 
      "𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™ :
        Hom β„­ (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈) b ↦cat_Set Ξ± Hom β„­ (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) b"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
    have 𝔑_abq: "(𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡q⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ b"
      by 
        (
          rule cat_Set_ArrVal_app_vrange[
            OF 𝔑ab, unfolded in_Hom_iff, OF that(3)
            ]
        )
    have "[g, f]∘ : [a, b]∘ ↦op_cat 𝔅 Γ—C β„­ [c, d]∘"
      by 
        (
          rule 
            cat_prod_2_is_arrI[
              OF 𝔉.HomDom.category_op category_axioms that(1,2)
              ]
        )
    then have 
      "𝔑⦇NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™ ∘Acat_Set Ξ± HomO.CΞ±β„­(π”Š-,-)⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ =
        HomO.CΞ±β„­(𝔉-,-)⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ ∘Acat_Set Ξ± 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™"
      by (rule is_ntcf.ntcf_Comp_commute[OF assms(3)])
    then have 
      "(𝔑⦇NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™ ∘A?Set ?Hπ”Šβ¦‡ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡q⦈ =
        (?H𝔉⦇ArrMapβ¦ˆβ¦‡g, fβ¦ˆβˆ™ ∘A?Set 𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡q⦈"
      by auto

    from 
      this that(2,3) assms
      category_axioms 𝔉.HomDom.category_axioms 𝔉.HomDom.category_op category_op
      g 𝔑ab 𝔑_abq 
    show
      "(𝔑⦇NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f ∘Aβ„­ (q ∘Aβ„­ π”Šβ¦‡ArrMapβ¦ˆβ¦‡g⦈)⦈ =
        f ∘Aβ„­ ((𝔑⦇NTMapβ¦ˆβ¦‡a, bβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡q⦈ ∘Aβ„­ 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈)" 
      by 
        (
          cs_prems
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed

  show ?thesis
  proof(rule is_ntcfI')

    show "vfsequence (af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑)"
      unfolding af_Yoneda_arrow_def by simp
    show "vcard (af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑) = 5β„•"
      unfolding af_Yoneda_arrow_def by (simp add: nat_omega_simps)

    have 𝔑b: "𝔑op_cat 𝔅,β„­(b,-)NTCF :
      HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) :
      β„­ ↦↦CΞ± cat_Set Ξ±"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
      by 
        (
          rule 
            bnt_proj_snd_is_ntcf
              [
                OF 𝔉.HomDom.category_op category_axioms assms(3),
                unfolded cat_op_simps, 
                OF that,
                unfolded 
                  cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) that]
                  cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) that]
              ]
        )

    show "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTMapβ¦ˆβ¦‡b⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
    proof-
      let ?π”Šb = β€Ήπ”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί
        and ?𝔉b = ‹𝔉⦇ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί
        and ?β„­π”Šb = ‹ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ¦ˆβ€Ί
      from that have β„­π”Šb: "?β„­π”Šb : ?π”Šb ↦ℭ ?π”Šb" by (auto simp: cat_cs_intros)
      from assms that have "[b, ?π”Šb]∘ ∈∘ (op_cat 𝔅 Γ—C β„­)⦇Obj⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_bπ”Šb: 
        "𝔑⦇NTMapβ¦ˆβ¦‡b, ?π”Šbβ¦ˆβˆ™ : Hom β„­ ?π”Šb ?π”Šb ↦cat_Set Ξ± Hom β„­ ?𝔉b ?π”Šb"
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from β„­π”Šb have 𝔑_bπ”Šb_β„­π”Šb: 
        "(𝔑⦇NTMapβ¦ˆβ¦‡b, ?π”Šbβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡?β„­π”Šb⦈ : ?𝔉b ↦ℭ ?π”Šb"
        by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_bπ”Šb, unfolded in_Hom_iff])
      with category_axioms assms that 𝔑b[OF that] show ?thesis
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
    qed

    show 
      "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 
        π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦𝔅 b" for a b f
    proof-

      from that have a: "a ∈∘ 𝔅⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈" by auto
      
      let ?𝔅a = ‹𝔅⦇CIdβ¦ˆβ¦‡aβ¦ˆβ€Ί
        and ?𝔅b = ‹𝔅⦇CIdβ¦ˆβ¦‡bβ¦ˆβ€Ί
        and ?π”Ša = β€Ήπ”Šβ¦‡ObjMapβ¦ˆβ¦‡aβ¦ˆβ€Ί
        and ?π”Šb = β€Ήπ”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί
        and ?𝔉a = ‹𝔉⦇ObjMapβ¦ˆβ¦‡aβ¦ˆβ€Ί
        and ?𝔉b = ‹𝔉⦇ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί
        and ?β„­π”Ša = ‹ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡aβ¦ˆβ¦ˆβ€Ί
        and ?β„­π”Šb = ‹ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ¦ˆβ€Ί

      from that have β„­π”Ša: "?β„­π”Ša : ?π”Ša ↦ℭ ?π”Ša" by (auto intro: cat_cs_intros)
      from that have β„­π”Šb: "?β„­π”Šb : ?π”Šb ↦ℭ ?π”Šb" by (auto intro: cat_cs_intros)
      from that have 𝔅a: "?𝔅a : a ↦𝔅 a" by (auto intro: cat_cs_intros)

      from assms that have "[b, ?π”Šb]∘ ∈∘ (op_cat 𝔅 Γ—C β„­)⦇Obj⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_bπ”Šb: 
        "𝔑⦇NTMapβ¦ˆβ¦‡b, ?π”Šbβ¦ˆβˆ™ : Hom β„­ ?π”Šb ?π”Šb ↦cat_Set Ξ± Hom β„­ ?𝔉b ?π”Šb"
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from β„­π”Šb have 𝔑_bπ”Šb_β„­π”Šb: 
        "(𝔑⦇NTMapβ¦ˆβ¦‡b, ?π”Šbβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡?β„­π”Šb⦈ : ?𝔉b ↦ℭ ?π”Šb"
        by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_bπ”Šb, unfolded in_Hom_iff])

      from assms that have "[a, ?π”Ša]∘ ∈∘ (op_cat 𝔅 Γ—C β„­)⦇Obj⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_aπ”Ša: 
        "𝔑⦇NTMapβ¦ˆβ¦‡a, ?π”Šaβ¦ˆβˆ™ : Hom β„­ ?π”Ša ?π”Ša ↦cat_Set Ξ± Hom β„­ ?𝔉a ?π”Ša"
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from β„­π”Ša have 𝔑_aπ”Ša_β„­π”Ša: 
        "(𝔑⦇NTMapβ¦ˆβ¦‡a, ?π”Šaβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡?β„­π”Ša⦈ : ?𝔉a ↦ℭ ?π”Ša"
        by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_aπ”Ša, unfolded in_Hom_iff])

      from 
        comm[OF 𝔅a π”Š.cf_ArrMap_is_arr[OF that] β„­π”Ša] 
        category_axioms assms that 𝔑_aπ”Ša_β„­π”Ša
      have 𝔑_a_π”Šb[symmetric, cat_cs_simps]:
        "(𝔑⦇NTMapβ¦ˆβ¦‡a, ?π”Šbβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈⦈ =
          π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (𝔑⦇NTMapβ¦ˆβ¦‡a, ?π”Šaβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡?β„­π”Ša⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from comm[OF that β„­π”Šb β„­π”Šb] category_axioms assms that 𝔑_bπ”Šb_β„­π”Šb
      have 𝔑_a_π”Šb'[cat_cs_simps]:
        "(𝔑⦇NTMapβ¦ˆβ¦‡a, ?π”Šbβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈⦈ =
          (𝔑⦇NTMapβ¦ˆβ¦‡b, ?π”Šbβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡?β„­π”Šb⦈ ∘Aβ„­ 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from category_axioms assms that 𝔑b[OF a] 𝔑b[OF b] show ?thesis
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

    qed

  qed (auto simp: af_Yoneda_arrow_components cat_cs_simps intro: cat_cs_intros)

qed

lemma (in category) cat_af_Yoneda_arrow_is_ntcf':
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 :
      HomO.CΞ±β„­(π”Š-,-) ↦CF HomO.CΞ±β„­(𝔉-,-) :
      op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    and "Ξ² = Ξ±"
    and "𝔉' = 𝔉"
    and "π”Š' = π”Š"
  shows "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑 : 𝔉' ↦CF π”Š' : 𝔅 ↦↦CΞ² β„­"
  using assms(1-3) unfolding assms(4-6) by (rule cat_af_Yoneda_arrow_is_ntcf)

lemmas [cat_cs_intros] = category.cat_af_Yoneda_arrow_is_ntcf'


subsubsectionβ€ΉYoneda Lemma for arbitrary functorsβ€Ί


textβ€Ή
The following lemmas correspond to variants of the elements of Lemma 3 
in subsection 1.15 in \cite{bodo_categories_1970}.
β€Ί

lemma (in category) cat_af_Yoneda_map_af_Yoneda_arrow_app:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" 
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 :
      HomO.CΞ±β„­(π”Š-,-) ↦CF HomO.CΞ±β„­(𝔉-,-) :
      op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "𝔑 = HomA.CΞ±(af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑-,-)"
proof-

  let ?Hπ”Š = β€ΉHomO.CΞ±β„­(π”Š-,-)β€Ί
    and ?H𝔉 = β€ΉHomO.CΞ±β„­(𝔉-,-)β€Ί
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑›

  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))

  interpret 𝔑: is_ntcf Ξ± β€Ήop_cat 𝔅 Γ—C β„­β€Ί β€Ήcat_Set Ξ±β€Ί β€Ή?Hπ”Šβ€Ί β€Ή?H𝔉› 𝔑
    by (rule assms(3))
  interpret aY𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š β€Ή?aYa 𝔑›
    by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms])
  interpret HY𝔑: is_ntcf 
    Ξ± β€Ήop_cat 𝔅 Γ—C β„­β€Ί β€Ήcat_Set Ξ±β€Ί β€Ή?Hπ”Šβ€Ί β€Ή?H𝔉› β€ΉHomA.CΞ±(?aYa 𝔑-,-)β€Ί
    by (rule cat_ntcf_lcomp_Hom_is_ntcf[OF aY𝔑.is_ntcf_axioms])
  
  show [cat_cs_simps]: "𝔑 = HomA.CΞ±(?aYa 𝔑-,-)"
  proof 
    (
      rule sym,
      rule ntcf_eqI[OF HY𝔑.is_ntcf_axioms assms(3)], 
      rule vsv_eqI;
      (intro HY𝔑.NTMap.vsv_axioms 𝔑.NTMap.vsv_axioms)?;
      (unfold 𝔑.ntcf_NTMap_vdomain HY𝔑.ntcf_NTMap_vdomain)?
    )
    fix bc assume prems': "bc ∈∘ (op_cat 𝔅 Γ—C β„­)⦇Obj⦈"
    then obtain b c
      where bc_def: "bc = [b, c]∘" 
        and op_b: "b ∈∘ op_cat 𝔅⦇Obj⦈" 
        and c: "c ∈∘ ℭ⦇Obj⦈"
      by (auto intro: cat_prod_2_ObjE cat_cs_intros)
    from op_b have b: "b ∈∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by simp

    then have π”Šb: "π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈" and 𝔉b: "𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈"
      by (auto intro: cat_cs_intros)
    have Ym_𝔑:
      "Yoneda_map Ξ± HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) (π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈)⦇
        𝔑op_cat 𝔅,β„­(b,-)NTCF
        ⦈ = ?aYa 𝔑⦇NTMapβ¦ˆβ¦‡b⦈"
      unfolding af_Yoneda_arrow_NTMap_app[OF assms(1) b] by simp
    
    from 
      bnt_proj_snd_is_ntcf
        [
          OF 𝔉.HomDom.category_op category_axioms assms(3) op_b,
          unfolded 
            cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) b]
            cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) b]
        ]
    have 𝔑b: "𝔑op_cat 𝔅,β„­(b,-)NTCF :
      HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) :
      β„­ ↦↦CΞ± cat_Set Ξ±"
      by simp
    from c show "HomA.CΞ±(?aYa 𝔑-,-)⦇NTMapβ¦ˆβ¦‡bc⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡bc⦈"
      unfolding 
        bc_def 
        cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app[OF aY𝔑.is_ntcf_axioms b c]
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(2)[
          OF π”Šb 𝔉b 𝔑b, unfolded Ym_𝔑, symmetric
          ]
      by (cs_concl cs_simp: cat_cs_simps)

  qed simp_all

qed

lemma (in category) cat_af_Yoneda_Lemma:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "v11 (af_Yoneda_map Ξ± 𝔉 π”Š)"
    and "β„›βˆ˜ (af_Yoneda_map Ξ± 𝔉 π”Š) =
    these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) HomO.CΞ±β„­(π”Š-,-) HomO.CΞ±β„­(𝔉-,-)"
    and "(af_Yoneda_map Ξ± 𝔉 π”Š)¯∘ =
      (
        Ξ»π”‘βˆˆβˆ˜these_ntcfs
          Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) HomO.CΞ±β„­(π”Š-,-) HomO.CΞ±β„­(𝔉-,-).
          af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑
      )"
proof-

  let ?Hπ”Š = β€ΉHomO.CΞ±β„­(π”Š-,-)β€Ί
    and ?H𝔉 = β€ΉHomO.CΞ±β„­(𝔉-,-)β€Ί
    and ?aYm = β€Ήaf_Yoneda_map Ξ± 𝔉 π”Šβ€Ί
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑›

  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))

  show v11_aY: "v11 ?aYm"
  proof
    (
      intro vsv.vsv_valeq_v11I,
      unfold af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
    )
    
    show "vsv (af_Yoneda_map Ξ± 𝔉 π”Š)" by (rule af_Yoneda_map_vsv[OF assms])

    fix Ο† ψ assume prems:
      "Ο† : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
      "ψ : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­" 
      "?aYmβ¦‡Ο†β¦ˆ = ?aYmβ¦‡Οˆβ¦ˆ"

    interpret Ο†: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š Ο† by (rule prems(1))
    interpret ψ: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š ψ by (rule prems(2))

    from prems(3) have HΟ†_Hψ: "HomA.CΞ±(Ο†-,-) = HomA.CΞ±(ψ-,-)"
      unfolding 
        af_Yoneda_map_app[OF assms prems(1)]
        af_Yoneda_map_app[OF assms prems(2)]
      by simp

    show "Ο† = ψ"
    proof
      (
        rule ntcf_eqI[OF prems(1,2)], 
        rule vsv_eqI, 
        unfold Ο†.ntcf_NTMap_vdomain ψ.ntcf_NTMap_vdomain
      )
      fix b assume prems': "b ∈∘ 𝔅⦇Obj⦈"
      from prems' have Ο†b: "φ⦇NTMapβ¦ˆβ¦‡b⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈" 
        and ψb: "Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈" 
        and π”Šb: "π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈" 
        and 𝔉b: "𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈"
        by (auto intro: cat_cs_intros cat_prod_cs_intros)
      have "HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-) = HomA.CΞ±β„­(Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈,-)"
      proof
        (
          rule 
            ntcf_eqI
              [
                OF 
                  cat_ntcf_Hom_snd_is_ntcf[OF Ο†b] 
                  cat_ntcf_Hom_snd_is_ntcf[OF ψb]
              ]
        )
        show "HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMap⦈ = HomA.CΞ±β„­(Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMap⦈"
        proof
          (
            rule vsv_eqI, 
            unfold 
              ntcf_Hom_snd_NTMap_vdomain[OF Ο†b]
              ntcf_Hom_snd_NTMap_vdomain[OF ψb]
          )
          fix c assume prems'': "c ∈∘ ℭ⦇Obj⦈"
          note H = cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
          show 
            "HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMapβ¦ˆβ¦‡c⦈ =
              HomA.CΞ±β„­(Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈,-)⦇NTMapβ¦ˆβ¦‡c⦈"
            unfolding 
              H[OF prems(1) prems' prems'', symmetric]
              H[OF prems(2) prems' prems'', symmetric]
              HΟ†_Hψ
            by simp
        qed 
          (
            simp_all add: 
              ntcf_Hom_snd_NTMap_vsv[OF ψb] ntcf_Hom_snd_NTMap_vsv[OF Ο†b]
          )
      qed simp_all
      with Ο†b ψb show "φ⦇NTMapβ¦ˆβ¦‡b⦈ = Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈"
        by (auto intro: cat_ntcf_Hom_snd_inj)
    qed auto

  qed

  interpret aYm: v11 ?aYm by (rule v11_aY)

  have [cat_cs_simps]: "?aYm⦇?aYa π”‘β¦ˆ = 𝔑"
    if "𝔑 : ?Hπ”Š ↦CF ?H𝔉 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±" for 𝔑
    using category_axioms assms that 
    by 
      (
        cs_concl 
          cs_simp: 
            cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric] cat_cs_simps
          cs_intro: cat_cs_intros
      )

  show aYm_vrange: 
    "β„›βˆ˜ ?aYm = these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) ?Hπ”Š ?H𝔉"
  proof(intro vsubset_antisym)
    
    show "β„›βˆ˜ ?aYm βŠ†βˆ˜ these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) ?Hπ”Š ?H𝔉"
    proof
      (
        rule vsv.vsv_vrange_vsubset, 
        unfold these_ntcfs_iff af_Yoneda_map_vdomain[OF assms]
      )
      fix Ο† assume "Ο† : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
      with category_axioms assms show 
        "?aYmβ¦‡Ο†β¦ˆ : ?Hπ”Š ↦CF ?H𝔉 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (auto intro: af_Yoneda_map_vsv)

    show "these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) ?Hπ”Š ?H𝔉 βŠ†βˆ˜ β„›βˆ˜ ?aYm"
    proof(rule vsubsetI, unfold these_ntcfs_iff)
      fix 𝔑 assume prems: 
        "𝔑 : ?Hπ”Š ↦CF ?H𝔉 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
      interpret aY𝔑: is_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š β€Ή?aYa 𝔑›
        by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
      from prems have 𝔑_def: "𝔑 = ?aYm⦇?aYa π”‘β¦ˆ" 
        by (cs_concl cs_simp: cat_cs_simps)
      from assms aY𝔑.is_ntcf_axioms have "?aYa 𝔑 ∈∘ π’Ÿβˆ˜ ?aYm"
        by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps)
      then show "𝔑 ∈∘ β„›βˆ˜ ?aYm" by (subst 𝔑_def, intro aYm.vsv_vimageI2) auto
    qed

  qed

  show "?aYm¯∘ =
    (Ξ»π”‘βˆˆβˆ˜these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) ?Hπ”Š ?H𝔉. ?aYa 𝔑)"
  proof
    (
      rule vsv_eqI, 
      unfold vdomain_vconverse vdomain_VLambda aYm_vrange these_ntcfs_iff
    )
    from aYm.v11_axioms show "vsv ((af_Yoneda_map Ξ± 𝔉 π”Š)¯∘)" by auto
    fix 𝔑 assume prems: "𝔑 : ?Hπ”Š ↦CF ?H𝔉 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    then have 𝔑: "𝔑 ∈∘ these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) ?Hπ”Š ?H𝔉" 
      by simp
    show "?aYmΒ―βˆ˜β¦‡π”‘β¦ˆ =
      (Ξ»π”‘βˆˆβˆ˜these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) ?Hπ”Š ?H𝔉. ?aYa 𝔑)β¦‡π”‘β¦ˆ"
    proof
      (
        intro aYm.v11_vconverse_app, 
        unfold beta[OF 𝔑] af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
      )
      from prems show 𝔑_def: "?aYm⦇?aYa π”‘β¦ˆ = 𝔑" 
        by (cs_concl cs_simp: cat_cs_simps)
      show "?aYa 𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
        by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
    qed
  qed simp_all

qed


subsubsectionβ€ΉInverse of the Yoneda map for arbitrary functorsβ€Ί

lemma (in category) inv_af_Yoneda_map_v11: 
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "v11 ((af_Yoneda_map Ξ± 𝔉 π”Š)¯∘)"
  using cat_af_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)

lemma (in category) inv_af_Yoneda_map_vdomain: 
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "π’Ÿβˆ˜ ((af_Yoneda_map Ξ± 𝔉 π”Š)¯∘) =
    these_ntcfs Ξ± (op_cat 𝔅 Γ—C β„­) (cat_Set Ξ±) HomO.CΞ±β„­(π”Š-,-) HomO.CΞ±β„­(𝔉-,-)"
  unfolding cat_af_Yoneda_Lemma(3)[OF assms] by simp

lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_vdomain

lemma (in category) inv_af_Yoneda_map_app: 
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 :
      HomO.CΞ±β„­(π”Š-,-) ↦CF  HomO.CΞ±β„­(𝔉-,-) :
      op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "(af_Yoneda_map Ξ± 𝔉 π”Š)Β―βˆ˜β¦‡π”‘β¦ˆ = af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑"
  using assms(3) unfolding cat_af_Yoneda_Lemma(3)[OF assms(1,2)] by simp

lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_app

lemma (in category) inv_af_Yoneda_map_vrange: 
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" and "π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "β„›βˆ˜ ((af_Yoneda_map Ξ± 𝔉 π”Š)¯∘) = these_ntcfs Ξ± 𝔅 β„­ 𝔉 π”Š"
proof-
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))
  from assms show ?thesis 
    unfolding af_Yoneda_map_def by (simp add: cat_cs_simps)
qed


subsubsectionβ€ΉYoneda map for arbitrary functors and natural isomorphismsβ€Ί


textβ€Ή
The following lemmas correspond to variants of the elements of
Lemma 3 in subsection 1.15 in \cite{bodo_categories_1970}.
β€Ί

lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf:
  assumes "Ο† : 𝔉 ↦CF.iso π”Š : 𝔅 ↦↦CΞ± β„­"
  shows "HomA.CΞ±(Ο†-,-) :
    HomO.CΞ±β„­(π”Š-,-) ↦CF.iso HomO.CΞ±β„­(𝔉-,-) :
    op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
proof-
  interpret Ο†: is_iso_ntcf Ξ± 𝔅 β„­ 𝔉 π”Š Ο† by (rule assms(1))
  show ?thesis
  proof(intro cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf)
    fix b assume "b ∈∘ 𝔅⦇Obj⦈"
    then show "HomA.CΞ±β„­(φ⦇NTMapβ¦ˆβ¦‡b⦈,-) :
      HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF.iso HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) :
      β„­ ↦↦CΞ± cat_Set Ξ±"
      by 
        (
          auto intro!: 
            cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf cat_arrow_cs_intros
        )
  qed (auto simp: cat_cs_intros)
qed

lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf':
  assumes "Ο† : 𝔉 ↦CF.iso π”Š : 𝔅 ↦↦CΞ± β„­"
    and "Ξ² = Ξ±"
    and "π”Š' = HomO.CΞ±β„­(π”Š-,-)"
    and "𝔉' = HomO.CΞ±β„­(𝔉-,-)"
    and "𝔅' = op_cat 𝔅 Γ—C β„­"
    and "β„­' = cat_Set Ξ±"
  shows "HomA.CΞ±(Ο†-,-) : π”Š' ↦CF.iso 𝔉' : 𝔅' ↦↦CΞ² β„­'"
  using assms(1)
  unfolding assms(2-6) 
  by (rule cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf)

lemmas [cat_cs_intros] = 
  category.cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf'

lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 :
      HomO.CΞ±β„­(π”Š-,-) ↦CF.iso HomO.CΞ±β„­(𝔉-,-) :
      op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
  shows "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑 : 𝔉 ↦CF.iso π”Š : 𝔅 ↦↦CΞ± β„­"
proof-
  
  let ?aYa = β€Ήaf_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑›
  
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))
  interpret 𝔑: is_iso_ntcf 
    Ξ± β€Ήop_cat 𝔅 Γ—C β„­β€Ί β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(π”Š-,-)β€Ί β€ΉHomO.CΞ±β„­(𝔉-,-)β€Ί 𝔑
    by (rule assms(3))

  from assms(1,2) 𝔑.is_ntcf_axioms have 𝔑_def: "𝔑 = HomA.CΞ±(?aYa-,-)" 
    by (cs_concl cs_simp: cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric])

  from category_axioms assms have aYa: "?aYa : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_cs_intros)
  have Hom_aYa: "HomA.CΞ±(?aYa-,-) :
    HomO.CΞ±β„­(π”Š-,-) ↦CF.iso HomO.CΞ±β„­(𝔉-,-) :
    op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    by (auto intro: assms(3) simp add: 𝔑_def[symmetric])
  have Hb:
    "HomA.CΞ±β„­(?aYa⦇NTMapβ¦ˆβ¦‡b⦈,-) :
      HomO.CΞ±β„­(π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈,-) ↦CF.iso HomO.CΞ±β„­(𝔉⦇ObjMapβ¦ˆβ¦‡b⦈,-) :
      β„­ ↦↦CΞ± cat_Set Ξ±"
    if "b ∈∘ 𝔅⦇Obj⦈" for b
    by 
      ( 
        rule cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf[
          OF aYa Hom_aYa that
          ]
      )

  show ?thesis
  proof(intro is_iso_ntcfI)
    from category_axioms assms show 
      "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑 : 𝔉 ↦CF π”Š : 𝔅 ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    fix b assume prems: "b ∈∘ 𝔅⦇Obj⦈"
    then have π”Šb: "π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈" and 𝔉b: "𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈"
      by (auto intro: cat_cs_intros)
    from assms(1,2) aYa prems have aYa_b: 
      "?aYa⦇NTMapβ¦ˆβ¦‡b⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps)
    show "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑⦇NTMapβ¦ˆβ¦‡b⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ↦isoβ„­ π”Šβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
      by 
        (
          rule cat_is_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf[
            OF aYa_b Hb[OF prems]
            ]
        )
  qed

qed

lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf':
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔑 :
      HomO.CΞ±β„­(π”Š-,-) ↦CF.iso HomO.CΞ±β„­(𝔉-,-) :
      op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    and "Ξ² = Ξ±"
    and "𝔉' = 𝔉"
    and "π”Š' = π”Š"
  shows "af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑 : 𝔉' ↦CF.iso π”Š' : 𝔅 ↦↦CΞ± β„­"
  using assms(1-3) 
  unfolding assms(4-6) 
  by (rule cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf)

lemmas [cat_cs_intros] = 
  category.cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf'

lemma (in category) cat_iso_functor_if_cf_lcomp_Hom_iso_functor:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­" 
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "HomO.CΞ±β„­(𝔉-,-) β‰ˆCFΞ± HomO.CΞ±β„­(π”Š-,-)"
  shows "𝔉 β‰ˆCFΞ± π”Š"
proof-
  let ?Hπ”Š = β€ΉHomO.CΞ±β„­(π”Š-,-)β€Ί
    and ?H𝔉 = β€ΉHomO.CΞ±β„­(𝔉-,-)β€Ί
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑›
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))
  from assms(3) obtain 𝔑 𝔄 𝔇 where 𝔑: "𝔑 : ?H𝔉 ↦CF.iso ?Hπ”Š : 𝔄 ↦↦CΞ± 𝔇"
    by auto
  interpret 𝔑: is_iso_ntcf Ξ± 𝔄 𝔇 ?H𝔉 ?Hπ”Š 𝔑 by (rule 𝔑)
  from category_axioms assms have "?H𝔉 : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have 𝔄_def: "𝔄 = op_cat 𝔅 Γ—C β„­" and 𝔇_def: "𝔇 = cat_Set Ξ±"
    by (force simp: cat_cs_simps)+
  note 𝔑 = 𝔑[unfolded 𝔄_def 𝔇_def]
  from 𝔑 have "𝔑 : ?H𝔉 ↦CF ?Hπ”Š : op_cat 𝔅 Γ—C β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
  from category_axioms assms 𝔑 have 
    "af_Yoneda_arrow Ξ± π”Š 𝔉 𝔑 : π”Š ↦CF.iso 𝔉 : 𝔅 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have "π”Š β‰ˆCFΞ± 𝔉" by (clarsimp intro!: iso_functorI)
  then show ?thesis by (rule iso_functor_sym)
qed

lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor:
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔉 β‰ˆCFΞ± π”Š"
  shows "HomO.CΞ±β„­(𝔉-,-) β‰ˆCFΞ± HomO.CΞ±β„­(π”Š-,-)"
proof-
  let ?Hπ”Š = β€ΉHomO.CΞ±β„­(π”Š-,-)β€Ί
    and ?H𝔉 = β€ΉHomO.CΞ±β„­(𝔉-,-)β€Ί
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow Ξ± 𝔉 π”Š 𝔑›
  interpret 𝔉: is_functor Ξ± 𝔅 β„­ 𝔉 by (rule assms(1))
  interpret π”Š: is_functor Ξ± 𝔅 β„­ π”Š by (rule assms(2))
  from assms obtain 𝔅' β„­' Ο† where Ο†: "Ο† : 𝔉 ↦CF.iso π”Š : 𝔅' ↦↦CΞ± β„­'"
    by auto
  interpret Ο†: is_iso_ntcf Ξ± 𝔅' β„­' 𝔉 π”Š Ο† by (rule Ο†)
  from assms Ο†.NTDom.is_functor_axioms 
  have 𝔅'_def: "𝔅' = 𝔅" and β„­'_def: "β„­' = β„­" 
    by fast+
  note Ο† = Ο†[unfolded 𝔅'_def β„­'_def]
  show ?thesis
    by (rule iso_functor_sym) 
      (
        intro iso_functorI[
          OF cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf[OF Ο†]
          ]
      )
qed

lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor':
  assumes "𝔉 : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : 𝔅 ↦↦CΞ± β„­"
    and "𝔉 β‰ˆCFΞ± π”Š"
    and "Ξ±' = Ξ±"
    and "β„­' = β„­"
  shows "HomO.CΞ±β„­(𝔉-,-) β‰ˆCFΞ± HomO.CΞ±'β„­'(π”Š-,-)"
  using assms(1-3) 
  unfolding assms(4,5) 
  by (rule cat_cf_lcomp_Hom_iso_functor_if_iso_functor)

lemmas [cat_cs_intros] = 
  category.cat_cf_lcomp_Hom_iso_functor_if_iso_functor'



subsectionβ€ΉThe Yoneda Functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III-2 in \cite{mac_lane_categories_2010}.β€Ί


definition Yoneda_functor :: "V β‡’ V β‡’ V"
  where "Yoneda_functor Ξ± 𝔇 =
    [
      (Ξ»r∈∘op_cat 𝔇⦇Obj⦈. cf_map (HomO.Cα𝔇(r,-))),
      (Ξ»f∈∘op_cat 𝔇⦇Arr⦈. ntcf_arrow (HomA.Cα𝔇(f,-))),
      op_cat 𝔇,
      cat_FUNCT Ξ± 𝔇 (cat_Set Ξ±)
    ]∘"


textβ€ΉComponents.β€Ί

lemma Yoneda_functor_components: 
  shows "Yoneda_functor Ξ± 𝔇⦇ObjMap⦈ =
      (Ξ»r∈∘op_cat 𝔇⦇Obj⦈. cf_map (HomO.Cα𝔇(r,-)))"
    and "Yoneda_functor Ξ± 𝔇⦇ArrMap⦈ =
      (Ξ»f∈∘op_cat 𝔇⦇Arr⦈. ntcf_arrow (HomA.Cα𝔇(f,-)))"
    and "Yoneda_functor Ξ± 𝔇⦇HomDom⦈ = op_cat 𝔇"
    and "Yoneda_functor Ξ± 𝔇⦇HomCod⦈ = cat_FUNCT Ξ± 𝔇 (cat_Set Ξ±)"
  unfolding Yoneda_functor_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda Yoneda_functor_components(1)
  |vsv Yoneda_functor_ObjMap_vsv[cat_cs_intros]|
  |vdomain Yoneda_functor_ObjMap_vdomain[cat_cs_simps]|
  |app Yoneda_functor_ObjMap_app[cat_cs_simps]|

lemma (in category) Yoneda_functor_ObjMap_vrange:
  "β„›βˆ˜ (Yoneda_functor Ξ± ℭ⦇ObjMap⦈) βŠ†βˆ˜ cat_FUNCT Ξ± β„­ (cat_Set Ξ±)⦇Obj⦈"
proof
  (
    unfold Yoneda_functor_components, 
    rule vrange_VLambda_vsubset, 
    unfold cat_op_simps
  )
  fix c assume "c ∈∘ ℭ⦇Obj⦈"
  with category_axioms show 
    "cf_map HomO.CΞ±β„­(c,-) ∈∘ cat_FUNCT Ξ± β„­ (cat_Set Ξ±)⦇Obj⦈" 
    unfolding cat_op_simps cat_FUNCT_components
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda Yoneda_functor_components(2)
  |vsv Yoneda_functor_ArrMap_vsv[cat_cs_intros]|
  |vdomain Yoneda_functor_ArrMap_vdomain[cat_cs_simps]|
  |app Yoneda_functor_ArrMap_app[cat_cs_simps]|

lemma (in category) Yoneda_functor_ArrMap_vrange:
  "β„›βˆ˜ (Yoneda_functor Ξ± ℭ⦇ArrMap⦈) βŠ†βˆ˜ cat_FUNCT Ξ± β„­ (cat_Set Ξ±)⦇Arr⦈"
proof
  (
    unfold Yoneda_functor_components, 
    rule vrange_VLambda_vsubset, 
    unfold cat_op_simps
  )
  fix f assume "f ∈∘ ℭ⦇Arr⦈"
  then obtain a b where f: "f : a ↦ℭ b" by auto
  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have 𝒡β: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²"
    by (simp_all add: 𝒡_Ξ±_Ξ±Ο‰ 𝒡.intro 𝒡_Limit_Ξ±Ο‰ 𝒡_Ο‰_Ξ±Ο‰ Ξ²_def)
  from tiny_category_cat_FUNCT category_axioms 𝒡β Ξ±Ξ² f show
    "ntcf_arrow HomA.CΞ±β„­(f,-) ∈∘ cat_FUNCT Ξ± β„­ (cat_Set Ξ±)⦇Arr⦈" 
    unfolding cat_op_simps
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed


subsubsectionβ€ΉThe Yoneda Functor is a fully faithful functorβ€Ί

lemma (in category) cat_Yoneda_functor_is_functor:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "Yoneda_functor Ξ± β„­ : op_cat β„­ ↦↦C.ffΞ² cat_FUNCT Ξ± β„­ (cat_Set Ξ±)"
proof
  (
    intro 
      is_ff_functorI 
      is_ft_functorI' 
      is_fl_functorI' 
      vsubset_antisym 
      vsubsetI,
    unfold cat_op_simps in_Hom_iff, 
    tacticβ€Ήdistinct_subgoals_tacβ€Ί
  )

  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (rule category_cat_Set)

  let ?Yf = β€ΉYoneda_functor Ξ± β„­β€Ί and ?FUNCT = β€Ήcat_FUNCT Ξ± β„­ (cat_Set Ξ±)β€Ί

  show Yf: "?Yf : op_cat β„­ ↦↦CΞ² ?FUNCT"
  proof(intro is_functorI')
    show "vfsequence ?Yf" unfolding Yoneda_functor_def by simp
    from assms have "category Ξ² β„­" by (intro cat_category_if_ge_Limit)
    then show "category Ξ² (op_cat β„­)" by (intro category.category_op)
    from assms show "category Ξ² ?FUNCT" 
      by (cs_concl cs_intro: cat_small_cs_intros tiny_category_cat_FUNCT)
    show "vcard ?Yf = 4β„•"
      unfolding Yoneda_functor_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (?Yf⦇ObjMap⦈) βŠ†βˆ˜ ?FUNCT⦇Obj⦈" 
      by (rule Yoneda_functor_ObjMap_vrange)
    show "?Yf⦇ArrMapβ¦ˆβ¦‡f⦈ : ?Yf⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) ?Yf⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦op_cat β„­ b" for a b f
      using that category_axioms
      unfolding cat_op_simps
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
    show "?Yf⦇ArrMapβ¦ˆβ¦‡g ∘Aop_cat β„­ f⦈ = 
      ?Yf⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A?FUNCT ?Yf⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦op_cat β„­ c" and "f : a ↦op_cat β„­ b" for b c g a f
      using that category_axioms
      unfolding cat_op_simps
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    show "?Yf⦇ArrMapβ¦ˆβ¦‡op_cat ℭ⦇CIdβ¦ˆβ¦‡c⦈⦈ = ?FUNCT⦇CIdβ¦ˆβ¦‡?Yf⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ op_cat ℭ⦇Obj⦈" for c 
      using that category_axioms
      unfolding cat_op_simps
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed (auto simp: assms(1) Yoneda_functor_components 𝒡.intro 𝒡_Limit_Ξ±Ο‰ 𝒡_Ο‰_Ξ±Ο‰)

  interpret Yf: is_functor Ξ² β€Ήop_cat β„­β€Ί β€Ή?FUNCTβ€Ί β€Ή?Yfβ€Ί by (rule Yf)

  show "v11 (?Yf⦇ArrMap⦈ β†Ύl∘ Hom β„­ b a)"
    if "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈" for a b
  proof-
    from that have dom_Y_ba: "π’Ÿβˆ˜ (?Yf⦇ArrMap⦈ β†Ύl∘ Hom β„­ b a) = Hom β„­ b a"
      by 
        (
          fastforce simp: 
            cat_op_simps 
            in_Hom_iff vdomain_vlrestriction Yoneda_functor_components
        )

    show "v11 (?Yf⦇ArrMap⦈ β†Ύl∘ Hom β„­ b a)"
    proof(intro vsv.vsv_valeq_v11I, unfold dom_Y_ba in_Hom_iff)
      fix g f assume prems:
        "g : b ↦ℭ a" 
        "f : b ↦ℭ a" 
        "(?Yf⦇ArrMap⦈ β†Ύl∘ Hom β„­ b a)⦇g⦈ = (?Yf⦇ArrMap⦈ β†Ύl∘ Hom β„­ b a)⦇f⦈"
      from 
        prems(3) category_axioms prems(1,2) Yoneda_functor_ArrMap_vsv[of Ξ± β„­] 
      have "HomA.CΞ±β„­(g,-) = HomA.CΞ±β„­(f,-)"
        by 
          (
            cs_prems
              cs_simp: V_cs_simps cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
              cs_intro: cat_cs_intros
          )
      from this prems(1,2) show "g = f" by (rule cat_ntcf_Hom_snd_inj)
    qed (auto simp: Yoneda_functor_components)
  qed

  fix a b assume prems: "a ∈∘ ℭ⦇Obj⦈" "b ∈∘ ℭ⦇Obj⦈"
  show "𝔑 : ?Yf⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) ?Yf⦇ObjMapβ¦ˆβ¦‡b⦈"
    if "𝔑 ∈∘ ?Yf⦇ArrMap⦈ `∘ Hom β„­ b a" for 𝔑
  proof-
    from that obtain f where "?Yf⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔑" and f: "f : b ↦ℭ a"
      by (force elim!: Yf.ArrMap.vsv_vimageE)
    then have 𝔑_def: "𝔑 = ntcf_arrow HomA.CΞ±β„­(f,-)"
      unfolding 
        Yoneda_functor_ArrMap_app[
          unfolded cat_op_simps, OF cat_is_arrD(1)[OF f]
          ]
      by (simp add: cat_cs_simps cat_op_simps cat_cs_intros)
    from category_axioms f show ?thesis
      unfolding 𝔑_def
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
        )
  qed
  show "𝔑 ∈∘ ?Yf⦇ArrMap⦈ `∘ Hom β„­ b a"
    if "𝔑 : ?Yf⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_FUNCT Ξ± β„­ (cat_Set Ξ±) ?Yf⦇ObjMapβ¦ˆβ¦‡b⦈" for 𝔑
  proof-
    note 𝔑 = cat_FUNCT_is_arrD[OF that]
    from 𝔑(1) category_axioms prems have ntcf_𝔑:
      "ntcf_of_ntcf_arrow β„­ (cat_Set Ξ±) 𝔑 : 
        HomO.CΞ±β„­(a,-) ↦CF HomO.CΞ±β„­(b,-) : β„­ ↦↦CΞ± cat_Set Ξ±"
      by (subst (asm) 𝔑(3), use nothing in β€Ήsubst (asm) 𝔑(4)β€Ί)
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
        )
    from cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF prems ntcf_𝔑] obtain f 
      where f: "f : b ↦ℭ a" 
        and 𝔑_def: "ntcf_of_ntcf_arrow β„­ (cat_Set Ξ±) 𝔑 = HomA.CΞ±β„­(f,-)"
      by auto
    from 𝔑(2) f show "𝔑 ∈∘ Yoneda_functor Ξ± ℭ⦇ArrMap⦈ `∘ Hom β„­ b a"
      unfolding 𝔑_def
      by (intro Yf.ArrMap.vsv_vimage_eqI[of f]) 
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)+
  qed
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Order

(* Copyright 2020 (C) Mihails Milehins *)

sectionβ€ΉOrdersβ€Ί
theory CZH_ECAT_Order
  imports 
    CZH_ECAT_Functor
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems cat_order_cs_simps
named_theorems cat_order_cs_intros



subsectionβ€ΉPreorder categoryβ€Ί


textβ€ΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.β€Ί

locale cat_preorder = category Ξ± β„­ for Ξ± β„­ +
  assumes cat_peo: 
    "⟦ a ∈∘ ℭ⦇Obj⦈; b ∈∘ ℭ⦇Obj⦈ ⟧ ⟹
      (βˆƒf. Hom β„­ a b = set {f}) ∨ (Hom β„­ a b = 0)"


textβ€ΉRules.β€Ί

lemma (in cat_preorder) cat_preorder_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "cat_preorder Ξ±' β„­"
  unfolding assms by (rule cat_preorder_axioms)

mk_ide rf cat_preorder_def[unfolded cat_preorder_axioms_def]
  |intro cat_preorderI|
  |dest cat_preorderD[dest]|
  |elim cat_preorderE[elim]|

lemmas [cat_order_cs_intros] = cat_preorderD(1)


textβ€ΉElementary properties.β€Ί

lemma (in cat_preorder) cat_peo_HomE:
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  obtains f where β€ΉHom β„­ a b = set {f}β€Ί | β€ΉHom β„­ a b = 0β€Ί
  using cat_peo[OF assms] by auto

lemma (in cat_preorder) cat_peo_is_thin_category:
  ―‹
  The statement of the lemma appears in
  nLab \cite{noauthor_nlab_nodate}\footnote{
  \url{https://ncatlab.org/nlab/show/preorder}
  }.β€Ί
  assumes "f : a ↦ℭ b" and "g : a ↦ℭ b"
  shows "f = g"
proof-
  note f = cat_is_arrD[OF assms(1)]
  from assms have "Hom β„­ a b β‰  0" by (metis HomI eq0_iff)
  with cat_peo_HomE[OF f(2,3)] obtain h where "Hom β„­ a b = set {h}" by auto
  moreover from assms have "f ∈∘ Hom β„­ a b" and "g ∈∘ Hom β„­ a b" by auto
  ultimately have "h = f" and "h = g" by auto
  then show ?thesis by auto
qed



subsectionβ€ΉOrder relationβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition is_le :: "V β‡’ V β‡’ V β‡’ bool" (infix ‹≀OΔ±β€Ί 50)
  where "a ≀Oβ„­ b ⟷ Hom β„­ a b β‰  0"


textβ€ΉRules.β€Ί

mk_ide is_le_def
  |intro is_leI|
  |dest is_leD[dest]|
  |elim is_leE[elim]|


textβ€ΉElementary properties.β€Ί

lemma (in cat_preorder) cat_peo_is_le[cat_order_cs_intros]: 
  assumes "f : a ↦ℭ b"
  shows "a ≀Oβ„­ b"
  using assms by (force intro: is_leI)

lemmas [cat_order_cs_intros] = cat_preorder.cat_peo_is_le

lemma (in cat_preorder) cat_peo_is_le_ex1:
  assumes "a ≀Oβ„­ b" and "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "βˆƒ!f. f : a ↦ℭ b"
proof-
  from assms have "Hom β„­ a b β‰  0" by auto
  with assms cat_peo obtain f where Hom_ab: "Hom β„­ a b = set {f}" by meson
  show "βˆƒ!f. f : a ↦ℭ b"
  proof(intro ex1I)
    from Hom_ab show "f : a ↦ℭ b" by auto
    fix g assume "g : a ↦ℭ b"
    with Hom_ab show "g = f" by auto
  qed
qed

lemma (in cat_preorder) cat_peo_is_le_ex[elim]:
  assumes "a ≀Oβ„­ b" and "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  obtains f where "f : a ↦ℭ b"
  using cat_peo_is_le_ex1[OF assms] that by clarsimp


subsubsectionβ€ΉOrder relation on a preorder category is a preorderβ€Ί

lemma (in cat_preorder) is_le_refl: 
  assumes "a ∈∘ ℭ⦇Obj⦈"
  shows "a ≀Oβ„­ a"
proof(intro is_leI)
  from assms have "ℭ⦇CIdβ¦ˆβ¦‡a⦈ ∈∘ Hom β„­ a a" by (cs_concl cs_intro: cat_cs_intros)
  then show "Hom β„­ a a β‰  0" by force
qed

lemma (in cat_preorder) is_le_trans: 
  assumes "a ∈∘ ℭ⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ≀Oβ„­ b"
    and "b ≀Oβ„­ c"
  shows "a ≀Oβ„­ c"
proof(intro is_leI)
  from assms obtain f where f: "f : a ↦ℭ b" by auto
  from assms obtain g where g: "g : b ↦ℭ c" by auto
  from f g have "g ∘Aβ„­ f : a ↦ℭ c"
    by (cs_concl cs_intro: cat_cs_intros)
  then show "Hom β„­ a c β‰  0" by force
qed



subsectionβ€ΉPartial order categoryβ€Ί


textβ€ΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.β€Ί

locale cat_partial_order = cat_preorder Ξ± β„­ for Ξ± β„­ +
  assumes cat_po: "⟦ a ∈∘ ℭ⦇Obj⦈; b ∈∘ ℭ⦇Obj⦈; a ≀Oβ„­ b; b ≀Oβ„­ a ⟧ ⟹ a = b"


textβ€ΉRules.β€Ί

lemma (in cat_partial_order) cat_partial_order_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "cat_partial_order Ξ±' β„­"
  unfolding assms by (rule cat_partial_order_axioms)

mk_ide rf cat_partial_order_def[unfolded cat_partial_order_axioms_def]
  |intro cat_partial_orderI|
  |dest cat_partial_orderD[dest]|
  |elim cat_partial_orderE[elim]|

lemmas [cat_order_cs_intros] = cat_partial_orderD(1)



subsectionβ€ΉLinear order categoryβ€Ί


textβ€ΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.β€Ί

locale cat_linear_order = cat_partial_order Ξ± β„­ for Ξ± β„­ +
  assumes cat_lo: "⟦ a ∈∘ ℭ⦇Obj⦈; b ∈∘ ℭ⦇Obj⦈ ⟧ ⟹ a ≀Oβ„­ b ∨ b ≀Oβ„­ a"


textβ€ΉRules.β€Ί

lemma (in cat_linear_order) cat_linear_order_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "cat_linear_order Ξ±' β„­"
  unfolding assms by (rule cat_linear_order_axioms)

mk_ide rf cat_linear_order_def[unfolded cat_linear_order_axioms_def]
  |intro cat_linear_orderI|
  |dest cat_linear_orderD[dest]|
  |elim cat_linear_orderE[elim]|

lemmas [cat_order_cs_intros] = cat_linear_orderD(1)



subsectionβ€ΉPreorder functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
See \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/monotone+function}
}.
β€Ί

locale is_preorder_functor = 
  is_functor Ξ± 𝔄 𝔅 𝔉 + HomDom: cat_preorder Ξ± 𝔄 + HomCod: cat_preorder Ξ± 𝔅
  for Ξ± 𝔄 𝔅 𝔉 

syntax "_is_preorder_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ≀C.PEOΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ≀C.PEOΞ± 𝔅" β‡Œ "CONST is_preorder_functor Ξ± 𝔄 𝔅 𝔉"


textβ€ΉRules.β€Ί

lemma (in is_preorder_functor) is_preorder_functor_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"
  shows "𝔉 : 𝔄' ≀C.PEOΞ±' 𝔅'"
  unfolding assms by (rule is_preorder_functor_axioms)
 
mk_ide rf is_preorder_functor_def
  |intro is_preorder_functorI|
  |dest is_preorder_functorD[dest]|
  |elim is_preorder_functorE[elim]|

lemmas [cat_order_cs_intros] = is_preorder_functorD


subsubsectionβ€ΉA preorder functor is a faithful functorβ€Ί

sublocale is_preorder_functor βŠ† is_ft_functor
proof(intro is_ft_functorI')
  fix a b assume "a ∈∘ 𝔄⦇Obj⦈" "b ∈∘ 𝔄⦇Obj⦈"
  show "v11 (𝔉⦇ArrMap⦈ β†Ύl∘ Hom 𝔄 a b)"
  proof
    (
      intro vsv.vsv_valeq_v11I, 
      unfold vdomain_vlrestriction cat_cs_simps vintersection_iff; 
      (elim conjE)?
    )
    fix g f assume "g : a ↦𝔄 b" "f : a ↦𝔄 b"  
    then show "g = f" by (auto simp: HomDom.cat_peo_is_thin_category)
  qed simp
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)


lemmas (in is_preorder_functor) is_preorder_functor_is_ft_functor = 
  is_ft_functor_axioms

lemmas [cat_order_cs_intros] = 
  is_preorder_functor.is_preorder_functor_is_ft_functor


subsubsectionβ€ΉA preorder functor is a monotone functionβ€Ί

lemma (in is_preorder_functor) cat_peo:
  ―‹
  Based on \cite{noauthor_nlab_nodate}\footnote{
  \url{https://ncatlab.org/nlab/show/monotone+function}
  }β€Ί
  assumes "a ∈∘ 𝔄⦇Obj⦈" and "b ∈∘ 𝔄⦇Obj⦈" and "a ≀O𝔄 b"
  shows "𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ≀O𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
proof-
  from assms obtain f where "f : a ↦𝔄 b" by auto
  then have "𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
    by (simp add: cf_ArrMap_is_arr)
  then show "𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ≀O𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
    by (cs_concl cs_intro: cat_order_cs_intros)
qed


subsubsectionβ€ΉComposition of preorder functorsβ€Ί

lemma cf_comp_is_preorder_functor[cat_order_cs_intros]:
  assumes "π”Š : 𝔅 ≀C.PEOΞ± β„­" and "𝔉 : 𝔄 ≀C.PEOΞ± 𝔅"
  shows "π”Š ∘CF 𝔉 : 𝔄 ≀C.PEOΞ± β„­"
proof-
  interpret π”Š: is_preorder_functor Ξ± 𝔅 β„­ π”Š by (rule assms(1))
  interpret 𝔉: is_preorder_functor Ξ± 𝔄 𝔅 𝔉 by (rule assms(2))
  show ?thesis
    by (intro is_preorder_functorI)
      (cs_concl cs_intro: cat_cs_intros cat_order_cs_intros)+
qed

lemma (in cat_preorder) cat_peo_cf_is_preorder_functor: 
  "cf_id β„­ : β„­ ≀C.PEOΞ± β„­"
  by (intro is_preorder_functorI)
    (cs_concl cs_intro: cat_cs_intros cat_order_cs_intros)+

lemma (in cat_preorder) cat_peo_cf_is_preorder_functor'[cat_order_cs_intros]:
  assumes "𝔄' = β„­" and "𝔅' = β„­"
  shows "cf_id β„­ : 𝔄' ≀C.PEOΞ± 𝔅'"
  unfolding assms by (rule cat_peo_cf_is_preorder_functor)

lemmas [cat_order_cs_intros] = cat_preorder.cat_peo_cf_is_preorder_functor'

end

Theory CZH_ECAT_Small_Order

(* Copyright 2020 (C) Mihails Milehins *)

sectionβ€ΉSmallness for ordersβ€Ί
theory CZH_ECAT_Small_Order
  imports 
    CZH_ECAT_Order
    CZH_ECAT_Small_Functor
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems cat_small_order_cs_simps
named_theorems cat_small_order_cs_intros



subsectionβ€ΉTiny preorder categoryβ€Ί

locale cat_tiny_preorder = tiny_category Ξ± β„­ for Ξ± β„­ + 
  assumes cat_tiny_peo:
    "⟦ a ∈∘ ℭ⦇Obj⦈; b ∈∘ ℭ⦇Obj⦈ ⟧ ⟹ 
      (βˆƒf. Hom β„­ a b = set {f}) ∨ (Hom β„­ a b = 0)"


textβ€ΉRules.β€Ί

lemma (in cat_tiny_preorder) cat_tiny_preorder_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "cat_tiny_preorder Ξ±' β„­"
  unfolding assms by (rule cat_tiny_preorder_axioms)

mk_ide rf cat_tiny_preorder_def[unfolded cat_tiny_preorder_axioms_def]
  |intro cat_tiny_preorderI|
  |dest cat_tiny_preorderD[dest]|
  |elim cat_tiny_preorderE[elim]|

lemmas [cat_small_order_cs_intros] = cat_tiny_preorderD(1)


textβ€ΉTiny preorder is a preorder.β€Ί

sublocale cat_tiny_preorder βŠ† cat_preorder
  by (intro cat_preorderI cat_tiny_peo category_axioms) simp_all

lemmas (in cat_tiny_preorder) cat_tiny_peo_is_cat_preoder = cat_preorder_axioms

lemmas [cat_small_order_cs_intros] = 
  cat_tiny_preorder.cat_tiny_peo_is_cat_preoder



subsectionβ€ΉTiny partial order categoryβ€Ί

locale cat_tiny_partial_order = cat_tiny_preorder Ξ± β„­ for Ξ± β„­ + 
  assumes cat_tiny_po:
    "⟦ a ∈∘ ℭ⦇Obj⦈; b ∈∘ ℭ⦇Obj⦈; a ≀Oβ„­ b; b ≀Oβ„­ a ⟧ ⟹ a = b"


textβ€ΉRules.β€Ί

lemma (in cat_tiny_partial_order) 
  cat_tiny_partial_order_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "cat_tiny_partial_order Ξ±' β„­"
  unfolding assms by (rule cat_tiny_partial_order_axioms)

mk_ide rf cat_tiny_partial_order_def[unfolded cat_tiny_partial_order_axioms_def]
  |intro cat_tiny_partial_orderI|
  |dest cat_tiny_partial_orderD[dest]|
  |elim cat_tiny_partial_orderE[elim]|

lemmas [cat_small_order_cs_intros] = cat_tiny_partial_orderD(1)


textβ€ΉTiny partial order is a partial order.β€Ί

sublocale cat_tiny_partial_order βŠ† cat_partial_order
  by (intro cat_partial_orderI cat_tiny_po cat_preorder_axioms) simp_all

lemmas (in cat_tiny_preorder) cat_tiny_po_is_cat_preoder = cat_preorder_axioms

lemmas [cat_small_order_cs_intros] = 
  cat_tiny_preorder.cat_tiny_peo_is_cat_preoder

lemma cat_tiny_partial_orderI':
  assumes "tiny_category Ξ± β„­"
    and "cat_partial_order Ξ± β„­"
  shows "cat_tiny_partial_order Ξ± β„­"
proof-
  interpret tiny_category Ξ± β„­ by (rule assms(1))
  interpret cat_partial_order Ξ± β„­ by (rule assms(2))
  show ?thesis
    by (intro cat_tiny_partial_orderI cat_tiny_preorderI assms(1) cat_po cat_peo)
qed



subsectionβ€ΉTiny linear order categoryβ€Ί

locale cat_tiny_linear_order = cat_tiny_partial_order Ξ± β„­ for Ξ± β„­ + 
  assumes cat_tiny_lo: "⟦ a ∈∘ ℭ⦇Obj⦈; b ∈∘ ℭ⦇Obj⦈ ⟧ ⟹ a ≀Oβ„­ b ∨ b ≀Oβ„­ a"


textβ€ΉRules.β€Ί

lemma (in cat_tiny_linear_order) 
  cat_tiny_linear_order_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "cat_tiny_linear_order Ξ±' β„­"
  unfolding assms by (rule cat_tiny_linear_order_axioms)

mk_ide rf cat_tiny_linear_order_def[unfolded cat_tiny_linear_order_axioms_def]
  |intro cat_tiny_linear_orderI|
  |dest cat_tiny_linear_orderD[dest]|
  |elim cat_tiny_linear_orderE[elim]|

lemmas [cat_small_order_cs_intros] = cat_tiny_linear_orderD(1)


textβ€ΉTiny linear order is a partial order.β€Ί

sublocale cat_tiny_linear_order βŠ† cat_linear_order
  by (intro cat_linear_orderI cat_tiny_lo cat_partial_order_axioms) simp_all

lemmas (in cat_tiny_linear_order) cat_tiny_lo_is_cat_partial_order = 
  cat_linear_order_axioms

lemmas [cat_small_order_cs_intros] = 
  cat_tiny_linear_order.cat_tiny_lo_is_cat_partial_order

lemma cat_tiny_linear_orderI':
  assumes "tiny_category Ξ± β„­" and "cat_linear_order Ξ± β„­"
  shows "cat_tiny_linear_order Ξ± β„­"
proof-
  interpret tiny_category Ξ± β„­ by (rule assms(1))
  interpret cat_linear_order Ξ± β„­ by (rule assms(2))
  show ?thesis
    by 
      (
        intro 
          assms(1) 
          cat_tiny_linear_orderI 
          cat_tiny_partial_orderI' 
          cat_partial_order_axioms 
          cat_lo
      )  
qed



subsectionβ€ΉTiny preorder functorβ€Ί

locale is_tiny_preorder_functor =
  is_functor Ξ± 𝔄 𝔅 𝔉 +
  HomDom: cat_tiny_preorder Ξ± 𝔄 +
  HomCod: cat_tiny_preorder Ξ± 𝔅
  for Ξ± 𝔄 𝔅 𝔉 

syntax "_is_tiny_preorder_functor" :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ≀C.PEO.tinyΔ± _)β€Ί [51, 51, 51] 51)
translations "𝔉 : 𝔄 ≀C.PEO.tinyΞ± 𝔅" β‡Œ 
  "CONST is_tiny_preorder_functor Ξ± 𝔄 𝔅 𝔉"


textβ€ΉRules.β€Ί

lemma (in is_tiny_preorder_functor) 
  is_tiny_preorder_functor_axioms'[cat_order_cs_intros]:
  assumes "Ξ±' = Ξ±" and "𝔄' = 𝔄" and "𝔅' = 𝔅"  
  shows "𝔉 : 𝔄' ≀C.PEO.tinyΞ±' 𝔅'"
  unfolding assms by (rule is_tiny_preorder_functor_axioms)

mk_ide rf is_tiny_preorder_functor_def
  |intro is_tiny_preorder_functorI|
  |dest is_tiny_preorder_functorD[dest]|
  |elim is_tiny_preorder_functorE[elim]|

lemmas [cat_small_order_cs_intros] = is_tiny_preorder_functorD(1)


textβ€ΉTiny preorder functor is a tiny functorβ€Ί

sublocale is_tiny_preorder_functor βŠ† is_tiny_functor
  by
    (
      intro
        is_tiny_functorI'
        is_functor_axioms
        HomDom.tiny_category_axioms
        HomCod.tiny_category_axioms
    )

end

Theory CZH_ECAT_Ordinal

(* Copyright 2020 (C) Mihails Milehins *)

sectionβ€ΉOrdinal numbersβ€Ί
theory CZH_ECAT_Ordinal
  imports CZH_ECAT_Small_Order
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The content of this section is based on the treatment of the ordinal numbers
from the perspective of category theory as exposed, for example,
in Chapter I-2 in \cite{mac_lane_categories_2010}.
β€Ί

named_theorems cat_ordinal_cs_simps
named_theorems cat_ordinal_cs_intros



subsectionβ€ΉArrows associated with an ordinal numberβ€Ί

definition ordinal_arrs :: "V β‡’ V"
  where "ordinal_arrs A ≑ set {[a, b]∘ | a b. a ∈∘ A ∧ b ∈∘ A ∧ a ≀ b}"

lemma small_ordinal_arrs[simp]: 
  "small {[a, b]∘ | a b. a ∈∘ A ∧ b ∈∘ A ∧ a ≀ b}"
  by (rule down[where x=β€ΉA Γ—βˆ™ Aβ€Ί]) auto


textβ€ΉRules.β€Ί

lemma ordinal_arrsI[cat_ordinal_cs_intros]:
  assumes "x = [a, b]∘" and "a ∈∘ A" and "b ∈∘ A" and "a ≀ b" 
  shows "x ∈∘ ordinal_arrs A"
  using assms unfolding ordinal_arrs_def by auto

lemma ordinal_arrsD[dest]:
  assumes "[a, b]∘ ∈∘ ordinal_arrs A"
  shows "a ∈∘ A" and "b ∈∘ A" and "a ≀ b" 
  using assms unfolding ordinal_arrs_def by auto

lemma ordinal_arrsE[elim]:
  assumes "x ∈∘ ordinal_arrs A"
  obtains a b where "a ∈∘ A" and "b ∈∘ A" and "a ≀ b" and "x = [a, b]∘"
  using assms unfolding ordinal_arrs_def by clarsimp



subsectionβ€ΉComposable arrowsβ€Ί

abbreviation ordinal_composable :: "V β‡’ V"
  where "ordinal_composable A ≑ set
    {
      [[b, c]∘, [a, b]∘]∘ | a b c. 
        a ∈∘ A ∧ b ∈∘ A ∧ c ∈∘ A ∧ a ≀ b ∧ b ≀ c
    }"

lemma small_ordinal_composable[simp]: 
  "small
    {
      [[b, c]∘, [a, b]∘]∘ | a b c.
        a ∈∘ A ∧ b ∈∘ A ∧ c ∈∘ A ∧ a ≀ b ∧ b ≀ c
    }"
  by (rule down[where x=β€Ή(A Γ—βˆ™ A) Γ—βˆ™ (A Γ—βˆ™ A)β€Ί]) auto


textβ€ΉRules.β€Ί

lemma ordinal_composableI[cat_ordinal_cs_intros]:
  assumes "x = [[b, c]∘, [a, b]∘]∘" 
    and "a ∈∘ A"
    and "b ∈∘ A"
    and "c ∈∘ A"
    and "a ≀ b"
    and "b ≀ c"
  shows "x ∈∘ ordinal_composable A"
  using assms by auto

lemma ordinal_composableD[dest]:
  assumes "[[b, c]∘, [a, b]∘]∘ ∈∘ ordinal_composable A"
  shows "a ∈∘ A" and "b ∈∘ A" and "c ∈∘ A" and "a ≀ b" and "b ≀ c"
  using assms by auto

lemma ordinal_composableE[elim]:
  assumes "x ∈∘ ordinal_composable A"
  obtains a b c 
    where "x = [[b, c]∘, [a, b]∘]∘"
      and "a ∈∘ A" 
      and "b ∈∘ A" 
      and "c ∈∘ A"
      and "a ≀ b"
      and "b ≀ c"
  using assms by clarsimp



subsectionβ€ΉOrdinal number as a categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_ordinal :: "V β‡’ V"
  where "cat_ordinal A =
    [
      A,
      ordinal_arrs A,
      (Ξ»f∈∘ordinal_arrs A. f⦇0⦈),
      (Ξ»f∈∘ordinal_arrs A. f⦇1β„•β¦ˆ),
      (Ξ»gf∈∘ordinal_composable A. [gf⦇1β„•β¦ˆβ¦‡0⦈, gf⦇0β¦ˆβ¦‡1β„•β¦ˆ]∘),
      (λx∈∘A. [x, x]∘)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_ordinal_components:
  shows [cat_ordinal_cs_simps]: "cat_ordinal A⦇Obj⦈ = A"
    and [cat_ordinal_cs_simps]: "cat_ordinal A⦇Arr⦈ = ordinal_arrs A"
    and "cat_ordinal A⦇Dom⦈ = (Ξ»f∈∘ordinal_arrs A. f⦇0⦈)"
    and "cat_ordinal A⦇Cod⦈ = (Ξ»f∈∘ordinal_arrs A. f⦇1β„•β¦ˆ)"
    and "cat_ordinal A⦇Comp⦈ =
      (Ξ»gf∈∘ordinal_composable A. [gf⦇1β„•β¦ˆβ¦‡0⦈, gf⦇0β¦ˆβ¦‡1β„•β¦ˆ]∘)"
    and "cat_ordinal A⦇CId⦈ = (Ξ»x∈∘A. [x, x]∘)"
  unfolding cat_ordinal_def dg_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉDomainβ€Ί

mk_VLambda cat_ordinal_components(3)
  |vsv cat_ordinal_Dom_vsv[cat_ordinal_cs_intros]|
  |vdomain 
    cat_ordinal_Dom_vdomain[
      folded cat_ordinal_components, cat_ordinal_cs_simps
      ]
  |

lemma cat_ordinal_Dom_app[cat_ordinal_cs_simps]:
  assumes "x ∈∘ cat_ordinal A⦇Arr⦈" and "x = [a, b]∘"
  shows "cat_ordinal A⦇Domβ¦ˆβ¦‡x⦈ = a"
  using assms(1) unfolding assms(2) cat_ordinal_components by auto

lemma cat_ordinal_Dom_vrange: "β„›βˆ˜ (cat_ordinal A⦇Dom⦈) βŠ†βˆ˜ cat_ordinal A⦇Obj⦈"
  unfolding cat_ordinal_components
  by (intro vrange_VLambda_vsubset, elim ordinal_arrsE) simp


subsubsectionβ€ΉCodomainβ€Ί

mk_VLambda cat_ordinal_components(4)
  |vsv cat_ordinal_Cod_vsv[cat_ordinal_cs_intros]|
  |vdomain 
    cat_ordinal_Cod_vdomain[
      folded cat_ordinal_components, cat_ordinal_cs_simps
      ]
  |

lemma cat_ordinal_Cod_app[cat_ordinal_cs_simps]:
  assumes "x ∈∘ cat_ordinal A⦇Arr⦈" and "x = [a, b]∘"
  shows "cat_ordinal A⦇Codβ¦ˆβ¦‡x⦈ = b"
  using assms(1)
  unfolding assms(2) cat_ordinal_components 
  by (auto simp: nat_omega_simps)

lemma cat_ordinal_Cod_vrange: "β„›βˆ˜ (cat_ordinal A⦇Cod⦈) βŠ†βˆ˜ cat_ordinal A⦇Obj⦈"
  unfolding cat_ordinal_components
  by (intro vrange_VLambda_vsubset, elim ordinal_arrsE) 
    (simp add: nat_omega_simps)


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί


textβ€ΉRules.β€Ί

lemma cat_ordinal_is_arrI[cat_ordinal_cs_intros]:
  assumes "a ∈∘ A" and "b ∈∘ A" and "a ≀ b" and "f = [a, b]∘"
  shows "f : a ↦cat_ordinal A b"
proof(intro is_arrI, unfold cat_ordinal_components(2))
  from assms show "f ∈∘ ordinal_arrs A" by (intro ordinal_arrsI)
  then show "cat_ordinal A⦇Domβ¦ˆβ¦‡f⦈ = a" "cat_ordinal A⦇Codβ¦ˆβ¦‡f⦈ = b"
    by (cs_concl cs_simp: cat_ordinal_cs_simps assms(4))+
qed

lemma cat_ordinal_is_arrD[dest]:
  assumes "f : a ↦cat_ordinal A b"
  shows "a ∈∘ A" and "b ∈∘ A" and "a ≀ b" and "f = [a, b]∘"
proof-
  note f = is_arrD[OF assms, unfolded cat_ordinal_components(2)]
  from f(1) obtain a' b' 
    where a': "a' ∈∘ A" 
      and b': "b' ∈∘ A" 
      and a'b': "a' ≀ b'" 
      and f_def: "f = [a', b']∘"
    unfolding ordinal_arrs_def by clarsimp
  from f(2) a' b' a'b' have a'_def: "a' = a" 
    by 
      (
        cs_prems 
          cs_simp: cat_ordinal_cs_simps f_def cs_intro: cat_ordinal_cs_intros
      )
  from f(3) a' b' a'b' have b'_def: "b' = b"
    by 
      (
        cs_prems 
          cs_simp: cat_ordinal_cs_simps f_def cs_intro: cat_ordinal_cs_intros
      )
  from a' b' a'b' f_def show "a ∈∘ A" and "b ∈∘ A" and "a ≀ b" and "f = [a, b]∘"
    unfolding a'_def b'_def by auto
qed

lemma cat_ordinal_is_arrE[elim]:
  assumes "f : a ↦cat_ordinal A b"
  obtains "a ∈∘ A" and "b ∈∘ A" and "a ≀ b" and "f = [a, b]∘"
  using assms by auto


textβ€ΉElementary properties.β€Ί

lemma cat_ordinal_is_arr_not:
  assumes "Β¬a ≀ b"
  shows "Β¬f : a ↦cat_ordinal A b"
proof(rule ccontr, unfold not_not)
  assume "f : a ↦cat_ordinal A b"
  with cat_ordinal_is_arrD(3)[OF this] assms show False by simp
qed

lemma cat_ordinal_is_arr_is_unique:
  assumes "f : a ↦cat_ordinal A b" and "g : a ↦cat_ordinal A b"  
  shows "f = g"
  by 
    (
      simp add: 
        cat_ordinal_is_arrD(4)[OF assms(1)] 
        cat_ordinal_is_arrD(4)[OF assms(2)]
    )

lemma cat_ordinal_Hom_ne:
  assumes "f : a ↦cat_ordinal A b"
  shows "Hom (cat_ordinal A) a b = set {f}"
  using assms cat_ordinal_is_arr_is_unique 
  by (intro vsubset_antisym vsubsetI) auto

lemma cat_ordinal_Hom_empty:
  assumes "Β¬a ≀ b"
  shows "Hom (cat_ordinal A) a b = 0"
  using assms by (intro vsubset_antisym vsubsetI) auto

lemma cat_ordinal_inj:
  assumes "cat_ordinal m = cat_ordinal n"
  shows "m = n"
  by (metis assms cat_ordinal_components(1))


subsubsectionβ€ΉCompositionβ€Ί

mk_VLambda cat_ordinal_components(5)
  |vsv cat_ordinal_Comp_vsv[cat_ordinal_cs_intros]|
  |vdomain cat_ordinal_Comp_vdomain[folded cat_ordinal_components, cat_cs_simps]|

lemma cat_ordinal_Comp_app[cat_ordinal_cs_simps]:
  assumes "g : b ↦cat_ordinal A c" and "f : a ↦cat_ordinal A b" 
  shows "g ∘Acat_ordinal A f = [a, c]∘"
proof-
  from assms(2) have a: "a ∈∘ A" 
    and b: "b ∈∘ A" 
    and ab: "a ≀ b" 
    and f_def: "f = [a, b]∘" 
    by auto
  from assms(1) have c: "c ∈∘ A" and bc: "b ≀ c" and g_def: "g = [b, c]∘" 
    by auto
  from a b c ab bc have "[g, f]∘ ∈∘ ordinal_composable A"
    by (cs_concl cs_simp: g_def f_def cs_intro: cat_ordinal_cs_intros)
  then show "g ∘Acat_ordinal A f = [a, c]∘"
    unfolding cat_ordinal_components by (simp add: g_def f_def nat_omega_simps)
qed


subsubsectionβ€ΉIdentityβ€Ί

mk_VLambda cat_ordinal_components(6)
  |vsv cat_ordinal_CId_vsv[cat_ordinal_cs_intros]|
  |vdomain cat_ordinal_CId_vdomain[cat_ordinal_cs_simps]|
  |app cat_ordinal_CId_app[cat_ordinal_cs_simps]|


subsubsectionβ€ΉOrder relationβ€Ί

lemma cat_ordinal_is_leD[dest]:
  assumes "a ≀Ocat_ordinal A b"
  shows "[a, b]∘ : a ↦cat_ordinal A b"
proof(intro cat_ordinal_is_arrI)
  from is_leD[OF assms] obtain f where "f : a ↦cat_ordinal A b" by fastforce
  then show "a ∈∘ A" "b ∈∘ A" "a βŠ†βˆ˜ b" by auto
qed simp

lemma cat_ordinal_is_leE[elim]:
  assumes "a ≀Ocat_ordinal A b"
  obtains "[a, b]∘ : a ↦cat_ordinal A b"
  using assms by auto 

lemma cat_ordinal_is_le_iff:
  "a ≀Ocat_ordinal A b ⟷ [a, b]∘ : a ↦cat_ordinal A b"
  using cat_ordinal_is_leD cat_ordinal_is_leE 
  by (metis HomI is_le_def vempty_nin)


subsubsectionβ€ΉEvery ordinal number is a categoryβ€Ί

lemma (in 𝒡) cat_linear_order_cat_ordinal[cat_ordinal_cs_intros]:
  assumes "Ord A" and "A βŠ†βˆ˜ Ξ±"
  shows "cat_linear_order Ξ± (cat_ordinal A)"
proof(intro cat_linear_orderI cat_partial_orderI cat_preorderI categoryI')
  show "vfsequence (cat_ordinal A)" unfolding cat_ordinal_def by auto
  show "vcard (cat_ordinal A) = 6β„•"
    unfolding cat_ordinal_def by (simp add: nat_omega_simps)
  show "β„›βˆ˜ (cat_ordinal A⦇Dom⦈) βŠ†βˆ˜ cat_ordinal A⦇Obj⦈"
    by (rule cat_ordinal_Dom_vrange)
  show "β„›βˆ˜ (cat_ordinal A⦇Cod⦈) βŠ†βˆ˜ cat_ordinal A⦇Obj⦈"
    by (rule cat_ordinal_Cod_vrange)
  show "(gf ∈∘ π’Ÿβˆ˜ (cat_ordinal A⦇Comp⦈)) ⟷
    (
      βˆƒg f b c a.
        gf = [g, f]∘ ∧ g : b ↦cat_ordinal A c ∧ f : a ↦cat_ordinal A b
    )"
    for gf
    unfolding cat_ordinal_Comp_vdomain
  proof
    assume "gf ∈∘ ordinal_composable A"
    then obtain a b c
      where gf_def: "gf = [[b, c]∘, [a, b]∘]∘" 
        and a: "a ∈∘ A" 
        and b: "b ∈∘ A"
        and c: "c ∈∘ A"
        and ab: "a ≀ b"
        and bc: "b ≀ c"
      by clarsimp
    from a b c ab bc show 
      "βˆƒg f b c a.
        gf = [g, f]∘ ∧ g : b ↦cat_ordinal A c ∧ f : a ↦cat_ordinal A b"
      unfolding gf_def
      by (intro exI conjI)
        (
          cs_concl 
            cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros
        )+
  next
    assume 
      "βˆƒg f b c a.
        gf = [g, f]∘ ∧
        g : b ↦cat_ordinal A c ∧ 
        f : a ↦cat_ordinal A b"
    then obtain g f b c a
      where gf_def: "gf = [g, f]∘"
        and g: "g : b ↦cat_ordinal A c"
        and f: "f : a ↦cat_ordinal A b"
      by clarsimp
    note g = cat_ordinal_is_arrD[OF g]
    note f = cat_ordinal_is_arrD[OF f]
    from g(1-3) f(1-3) show "gf ∈∘ ordinal_composable A"
      unfolding gf_def g(4) f(4)
      by 
        (
          cs_concl 
            cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros
        )
  qed
  show [cat_ordinal_cs_intros]: "g ∘Acat_ordinal A f : a ↦cat_ordinal A c"
    if "g : b ↦cat_ordinal A c" and "f : a ↦cat_ordinal A b" for b c g a f
  proof-
    note g = cat_ordinal_is_arrD[OF that(1)]
    note f = cat_ordinal_is_arrD[OF that(2)]
    show ?thesis
    proof(intro cat_ordinal_is_arrI g(1,2) f(1,2), unfold g(4) f(4))
      from g(3) f(3) show "a βŠ†βˆ˜ c" by auto
      from g(1,2,3) f(1,2,3) show " [b, c]∘ ∘Acat_ordinal A [a, b]∘ = [a, c]∘"
        by 
          (
            cs_concl 
              cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros
          )
    qed
  qed
  show
    "h ∘Acat_ordinal A g ∘Acat_ordinal A f =
      h ∘Acat_ordinal A (g ∘Acat_ordinal A f)"
    if "h : c ↦cat_ordinal A d"
      and "g : b ↦cat_ordinal A c"
      and "f : a ↦cat_ordinal A b"
    for c d h b g a f
  proof-
    note h = cat_ordinal_is_arrD[OF that(1)]
    note g = cat_ordinal_is_arrD[OF that(2)]
    note f = cat_ordinal_is_arrD[OF that(3)]
    from that(1-3) h(1-3) g(1-4) f(1-3) show ?thesis
      unfolding h(4) g(4) f(4) (*slow*)
      by (cs_concl cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros)
  qed
  show "cat_ordinal A⦇CIdβ¦ˆβ¦‡a⦈ : a ↦cat_ordinal A a"
    if "a ∈∘ cat_ordinal A⦇Obj⦈" for a
  proof- 
    from that have "a ∈∘ A" unfolding cat_ordinal_components by simp
    then show "cat_ordinal A⦇CIdβ¦ˆβ¦‡a⦈ : a ↦cat_ordinal A a"
      by 
        (
          cs_concl 
            cs_simp: cat_ordinal_cs_simps
            cs_intro: cat_ordinal_cs_intros V_cs_intros
        )
  qed
  show "cat_ordinal A⦇CIdβ¦ˆβ¦‡b⦈ ∘Acat_ordinal A f = f"
    if "f : a ↦cat_ordinal A b" for a b f
  proof-
    note f = cat_ordinal_is_arrD[OF that]
    from f(1-3) show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_ordinal_cs_simps f(4)
            cs_intro: cat_ordinal_cs_intros V_cs_intros
        )
  qed
  show "f ∘Acat_ordinal A cat_ordinal A⦇CIdβ¦ˆβ¦‡b⦈ = f"
    if "f : b ↦cat_ordinal A c" for b c f
  proof-
    note f = cat_ordinal_is_arrD[OF that]
    from f(1-3) show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_ordinal_cs_simps f(4)
            cs_intro: cat_ordinal_cs_intros V_cs_intros
        )
  qed
  from assms Ord_Ξ± show "cat_ordinal A⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    unfolding cat_ordinal_components by auto
  show "(β‹ƒβˆ˜b∈∘B. β‹ƒβˆ˜c∈∘C. Hom (cat_ordinal A) b c) ∈∘ Vset Ξ±"
    if "B βŠ†βˆ˜ cat_ordinal A⦇Obj⦈" 
      and "C βŠ†βˆ˜ cat_ordinal A⦇Obj⦈"
      and "B ∈∘ Vset α"
      and "C ∈∘ Vset α"
    for B C
  proof-
    have "(β‹ƒβˆ˜b∈∘B. β‹ƒβˆ˜c∈∘C. Hom (cat_ordinal A) b c) βŠ†βˆ˜ B Γ—βˆ™ C"
    proof(rule vsubsetI)
      fix f assume "f ∈∘ (β‹ƒβˆ˜b∈∘B. β‹ƒβˆ˜c∈∘C. Hom (cat_ordinal A) b c)"
      then obtain b c 
        where b: "b ∈∘ B" and c: "c ∈∘ C" and f: "f : b ↦cat_ordinal A c" 
        by auto
      note f = cat_ordinal_is_arrD[OF f]
      from b c show "f ∈∘ B Γ—βˆ™ C"
        unfolding f(4) by auto
    qed
    moreover from that(3,4) have "B Γ—βˆ™ C ∈∘ Vset Ξ±"
      by (auto intro: Limit_ftimes_in_VsetI)
    ultimately show ?thesis by blast
  qed
  show "(βˆƒf. Hom (cat_ordinal A) a b = set {f}) ∨ Hom (cat_ordinal A) a b = 0"
    if "a ∈∘ cat_ordinal A⦇Obj⦈" and "b ∈∘ cat_ordinal A⦇Obj⦈" for a b
  proof-
    from that have a: "a ∈∘ A" and b: "b ∈∘ A"
      unfolding cat_ordinal_components by simp_all
    then consider β€Ήa ≀ bβ€Ί | β€ΉΒ¬a ≀ bβ€Ί by auto
    then show ?thesis
    proof cases
      case 1
      with a b have "[a, b]∘ : a ↦cat_ordinal A b"
        by (auto intro: cat_ordinal_is_arrI)
      then show ?thesis by (simp add: cat_ordinal_Hom_ne)
    qed (simp add: cat_ordinal_Hom_empty)
  qed
  show "a = b"
    if "a ∈∘ cat_ordinal A⦇Obj⦈"
      and "b ∈∘ cat_ordinal A⦇Obj⦈"
      and "a ≀Ocat_ordinal A b"
      and "b ≀Ocat_ordinal A a"
    for a b
    using 
      that(3,4)[unfolded cat_ordinal_is_le_iff cat_ordinal_components]
      cat_ordinal_is_arr_is_unique
    by auto
  show "a ≀Ocat_ordinal A b ∨ b ≀Ocat_ordinal A a"
    if "a ∈∘ cat_ordinal A⦇Obj⦈" and "b ∈∘ cat_ordinal A⦇Obj⦈" for a b
  proof-
    from that[unfolded cat_ordinal_components] have a: "a ∈∘ A" and b: "b ∈∘ A"
      by simp_all
    with assms have "Ord a" "Ord b" by auto
    then consider β€Ήa ≀ bβ€Ί | β€Ήb ≀ aβ€Ί by (meson Ord_linear_le)
    then show "a ≀Ocat_ordinal A b ∨ b ≀Ocat_ordinal A a"
      by cases (auto simp: a b cat_ordinal_is_le_iff intro: cat_ordinal_is_arrI)
  qed
qed (auto intro: cat_ordinal_cs_intros simp: cat_ordinal_cs_simps)

lemmas [cat_ordinal_cs_intros] = 𝒡.cat_linear_order_cat_ordinal

lemma (in 𝒡) cat_tiny_linear_order_cat_ordinal[cat_ordinal_cs_intros]:
  assumes "Ord A" and "A ∈∘ α"
  shows "cat_tiny_linear_order Ξ± (cat_ordinal A)"
proof(intro cat_tiny_linear_orderI' cat_linear_order_cat_ordinal assms(1))
  from assms show "A βŠ†βˆ˜ Ξ±"
    by (meson Ord_Ξ± Ord_linear_le mem_not_refl vsubsetE)
  from assms(1) this interpret A: cat_linear_order Ξ± β€Ήcat_ordinal Aβ€Ί
    by (intro cat_linear_order_cat_ordinal)
  from assms(2) have A_in_Vset: "A ∈∘ Vset α" by (simp add: Ord_α Ord_in_in_VsetI)
  have "cat_ordinal A⦇Arr⦈ βŠ†βˆ˜ A Γ—βˆ™ A"
    unfolding ordinal_arrs_def cat_ordinal_components by clarsimp
  moreover from A_in_Vset have "A Γ—βˆ™ A ∈∘ Vset Ξ±"
    by (intro Limit_ftimes_in_VsetI) auto
  ultimately have "cat_ordinal A⦇Arr⦈ ∈∘ Vset Ξ±"
    using vsubset_in_VsetI unfolding cat_ordinal_components by simp
  moreover have "cat_ordinal A⦇Obj⦈ ∈∘ Vset Ξ±"
    unfolding cat_ordinal_components by (intro A_in_Vset)
  ultimately show "tiny_category Ξ± (cat_ordinal A)"
    by (cs_concl cs_intro: cat_cs_intros tiny_categoryI')
qed

lemmas [cat_ordinal_cs_intros] = 𝒡.cat_linear_order_cat_ordinal

lemma (in 𝒡) finite_category_cat_ordinal[cat_ordinal_cs_intros]:
  assumes "a ∈∘ Ο‰"
  shows "finite_category Ξ± (cat_ordinal a)"
proof-
  from assms have "Ord a" "a ∈∘ α" by (auto simp: Ord_α Ord_trans)
  then interpret cat_ordinal: cat_tiny_linear_order Ξ± β€Ήcat_ordinal aβ€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  show ?thesis
  proof(intro finite_categoryI')
    from assms show "category Ξ± (cat_ordinal a)"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "vfinite (cat_ordinal a⦇Obj⦈)"
      unfolding cat_ordinal_components by auto
    from assms show "vfinite (cat_ordinal a⦇Arr⦈)"
    proof-
      have "cat_ordinal a⦇Arr⦈ βŠ†βˆ˜ a Γ—βˆ™ a"
        unfolding cat_ordinal_components by auto
      moreover from assms have "vfinite (a Γ—βˆ™ a)"
        by (intro vfinite_ftimesI) auto
      ultimately show ?thesis by (auto simp: vfinite_vsubset)
    qed
  qed
qed

lemmas [cat_ordinal_cs_intros] = 𝒡.finite_category_cat_ordinal

end

Theory CZH_ECAT_CSimplicial

(* Copyright 2020 (C) Mihails Milehins *)

sectionβ€ΉSimplicial categoryβ€Ί
theory CZH_ECAT_CSimplicial
  imports CZH_ECAT_Ordinal
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The content of this section is based, primarily, on the elements of the 
content of Chapter I-2 in \cite{mac_lane_categories_2010}.
β€Ί

named_theorems cat_simplicial_cs_simps
named_theorems cat_simplicial_cs_intros



subsectionβ€ΉComposable arrows for simplicial categoryβ€Ί

definition composable_cat_simplicial :: "V β‡’ V β‡’ V"
  where "composable_cat_simplicial Ξ± A = set
    {
      [g, f]∘ | g f. βˆƒm n p.
        g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p ∧
        f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧
        m ∈∘ A ∧ n ∈∘ A ∧ p ∈∘ A
    }"

lemma small_composable_cat_simplicial[simp]:
  "small
    {
      [g, f]∘ | g f. βˆƒm n p.
        g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p ∧
        f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧
        m ∈∘ A ∧ n ∈∘ A ∧ p ∈∘ A
    }"
  (is β€Ήsmall ?Sβ€Ί)
proof(rule down)
  show "?S βŠ† elts (all_cfs Ξ± Γ—βˆ™ all_cfs Ξ±)"
  proof
    (
      intro subsetI, 
      unfold mem_Collect_eq, elim exE conjE; simp only:; intro ftimesI2
    )
    fix m n p g f 
    assume prems: 
      "m ∈∘ A"
      "n ∈∘ A"
      "p ∈∘ A"
      "g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p"
      "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    interpret g: is_preorder_functor Ξ± β€Ήcat_ordinal nβ€Ί β€Ήcat_ordinal pβ€Ί g
      by (rule prems(4))
    interpret f: is_preorder_functor Ξ± β€Ήcat_ordinal mβ€Ί β€Ήcat_ordinal nβ€Ί f
      by (rule prems(5))
    from g.is_functor_axioms show "g ∈∘ all_cfs α" by auto
    from f.is_functor_axioms show "f ∈∘ all_cfs α" by auto
  qed
qed


textβ€ΉRules.β€Ί

lemma composable_cat_simplicialI:
  assumes "g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p"
    and "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    and "m ∈∘ A" 
    and "n ∈∘ A"
    and "p ∈∘ A"
    and "gf = [g, f]∘"
  shows "gf ∈∘ composable_cat_simplicial α A"
  using assms
  unfolding composable_cat_simplicial_def
  by (intro in_small_setI small_composable_cat_simplicial) auto

lemma composable_cat_simplicialE[elim]:
  assumes "gf ∈∘ composable_cat_simplicial α A"
  obtains g f m n p where "gf = [g, f]∘" 
    and "g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p"
    and "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    and "m ∈∘ A" 
    and "n ∈∘ A"
    and "p ∈∘ A"
proof-
  from assms obtain g f m n p where 
    "gf = [g, f]∘"
    "g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p"
    "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    "m ∈∘ A" 
    "n ∈∘ A" 
    "p ∈∘ A"
    unfolding composable_cat_simplicial_def
    by (elim in_small_setE, intro small_composable_cat_simplicial) auto
  with that show ?thesis by auto
qed



subsectionβ€ΉSimplicial categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cat_simplicial :: "V β‡’ V β‡’ V"
  where "cat_simplicial Ξ± A =
    [
      set {cat_ordinal m | m. m ∈∘ A},
      set
        {
          f. βˆƒm n.
            f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧ m ∈∘ A ∧ n ∈∘ A
        },
      (
        λf∈∘ set
          {
            f. βˆƒm n.
              f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧ m ∈∘ A ∧ n ∈∘ A
          }. f⦇HomDom⦈
      ),
      (
        λf∈∘ set
          {
            f. βˆƒm n.
              f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧ m ∈∘ A ∧ n ∈∘ A
          }. f⦇HomCod⦈
      ),
      (Ξ»gf∈∘composable_cat_simplicial Ξ± A. gf⦇0⦈ ∘CF gf⦇1β„•β¦ˆ),
      (λm∈∘set {cat_ordinal m | m. m ∈∘ A}. cf_id m)
    ]∘"


textβ€ΉComponents.β€Ί

lemma cat_simplicial_components:
  shows "cat_simplicial Ξ± A⦇Obj⦈ = set {cat_ordinal m | m. m ∈∘ A}"
    and "cat_simplicial Ξ± A⦇Arr⦈ = 
      set {f. βˆƒm n. f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧ m ∈∘ A ∧ n ∈∘ A}"
    and "cat_simplicial Ξ± A⦇Dom⦈ =
      (
        λf∈∘set
          {
            f. βˆƒm n.
              f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧ m ∈∘ A ∧ n ∈∘ A
          }. f⦇HomDom⦈
      )"
    and "cat_simplicial Ξ± A⦇Cod⦈ =
      (
        λf∈∘set
          {
            f. βˆƒm n.
              f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧ m ∈∘ A ∧ n ∈∘ A
          }. f⦇HomCod⦈
      )"
    and "cat_simplicial Ξ± A⦇Comp⦈ =
      (Ξ»gf∈∘composable_cat_simplicial Ξ± A. gf⦇0⦈ ∘CF gf⦇1β„•β¦ˆ)"
    and "cat_simplicial Ξ± A⦇CId⦈ =
      (λm∈∘set {cat_ordinal m | m. m ∈∘ A}. cf_id m)"
  unfolding cat_simplicial_def dg_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObjectsβ€Ί

lemma cat_simplicial_ObjI[cat_simplicial_cs_intros]:
  assumes "m ∈∘ A" and "a = cat_ordinal m"
  shows "a ∈∘ cat_simplicial Ξ± A⦇Obj⦈ "
  using assms unfolding cat_simplicial_components by auto

lemma cat_simplicial_ObjD:
  assumes "cat_ordinal m ∈∘ cat_simplicial Ξ± A⦇Obj⦈ "
  shows "m ∈∘ A" 
  using assms cat_ordinal_inj unfolding cat_simplicial_components by auto

lemma cat_simplicial_ObjE:
  assumes "M ∈∘ cat_simplicial Ξ± A⦇Obj⦈ "
  obtains m where "M = cat_ordinal m" and "m ∈∘ A" 
  using assms cat_ordinal_inj that unfolding cat_simplicial_components by auto


subsubsectionβ€ΉArrowsβ€Ί

lemma small_cat_simplicial_Arr[simp]: 
  "small {f. βˆƒm n. f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n ∧ m ∈∘ A ∧ n ∈∘ A}"
  (is β€Ήsmall ?Sβ€Ί)
proof(rule down)
  show "?S βŠ† elts (all_cfs Ξ±)" by auto
qed

lemma cat_simplicial_ArrI[cat_simplicial_cs_intros]:
  assumes "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n" and "m ∈∘ A" and "n ∈∘ A" 
  shows "f ∈∘ cat_simplicial Ξ± A⦇Arr⦈"
  using assms 
  unfolding cat_simplicial_components
  by (intro in_small_setI small_cat_simplicial_Arr) auto

lemma cat_simplicial_ArrE:
  assumes "f ∈∘ cat_simplicial Ξ± A⦇Arr⦈"
  obtains m n 
    where "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n" and "m ∈∘ A" and "n ∈∘ A" 
proof-
  from assms cat_ordinal_inj obtain m n 
    where "m ∈∘ A" "n ∈∘ A" "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    unfolding cat_simplicial_components
    by (elim in_small_setE, intro small_cat_simplicial_Arr) auto
  with that show ?thesis by simp
qed


subsubsectionβ€ΉDomainβ€Ί

mk_VLambda cat_simplicial_components(3)
  |vsv cat_simplicial_Dom_vsv[cat_simplicial_cs_intros]|
  |vdomain 
    cat_simplicial_Dom_vdomain[
      folded cat_simplicial_components, cat_simplicial_cs_simps
    ]
  |
  |app cat_simplicial_Dom_app[folded cat_simplicial_components]|

lemma cat_simplicial_Dom_app'[cat_simplicial_cs_simps]:
  assumes "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n" and "m ∈∘ A" and "n ∈∘ A" 
  shows "cat_simplicial Ξ± A⦇Domβ¦ˆβ¦‡f⦈ = cat_ordinal m"
proof-
  interpret f: is_preorder_functor Ξ± β€Ήcat_ordinal mβ€Ί β€Ήcat_ordinal nβ€Ί f 
    by (rule assms(1))
  from assms show "cat_simplicial Ξ± A⦇Domβ¦ˆβ¦‡f⦈ = cat_ordinal m"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_simplicial_Dom_app 
          cs_intro: cat_simplicial_cs_intros
      )
qed


subsubsectionβ€ΉCodomainβ€Ί

mk_VLambda cat_simplicial_components(4)
  |vsv cat_simplicial_Cod_vsv[cat_simplicial_cs_intros]|
  |vdomain 
    cat_simplicial_Cod_vdomain[
      folded cat_simplicial_components, cat_simplicial_cs_simps
    ]
  |
  |app cat_simplicial_Cod_app[folded cat_simplicial_components]|


lemma cat_simplicial_Cod_app'[cat_simplicial_cs_simps]:
  assumes "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n" and "m ∈∘ A" and "n ∈∘ A" 
  shows "cat_simplicial Ξ± A⦇Codβ¦ˆβ¦‡f⦈ = cat_ordinal n"
proof-
  interpret f: is_preorder_functor Ξ± β€Ήcat_ordinal mβ€Ί β€Ήcat_ordinal nβ€Ί f 
    by (rule assms(1))
  from assms show "cat_simplicial Ξ± A⦇Codβ¦ˆβ¦‡f⦈ = cat_ordinal n"
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps cat_simplicial_Cod_app 
          cs_intro: cat_simplicial_cs_intros
      )
qed


subsubsectionβ€ΉArrow with a domain and a codomainβ€Ί

lemma cat_simplicial_is_arrI: 
  assumes "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    and "m ∈∘ A" 
    and "n ∈∘ A"
  shows "f : cat_ordinal m ↦cat_simplicial Ξ± A cat_ordinal n"
proof(intro is_arrI cat_simplicial_ArrI, rule assms; (intro assms(2,3))?)
  from assms show 
    "cat_simplicial Ξ± A⦇Domβ¦ˆβ¦‡f⦈ = cat_ordinal m"
    "cat_simplicial Ξ± A⦇Codβ¦ˆβ¦‡f⦈ = cat_ordinal n"
    by (cs_concl cs_simp: cat_simplicial_cs_simps)+
qed

lemma cat_simplicial_is_arrI'[cat_simplicial_cs_intros]: 
  assumes "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    and "m ∈∘ A" 
    and "n ∈∘ A"
    and "a = cat_ordinal m"
    and "b = cat_ordinal n"
  shows "f : a ↦cat_simplicial Ξ± A b"
  using assms(1-3) unfolding assms(4-5) by (rule cat_simplicial_is_arrI)

lemma cat_simplicial_is_arrD[dest]: 
  assumes "f : cat_ordinal m ↦cat_simplicial Ξ± A cat_ordinal n"
    and "m ∈∘ A" 
    and "n ∈∘ A"
  shows "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
proof-
  note f = is_arrD[OF assms(1)]
  from f(1) obtain m' n' 
    where f_is_preorder_functor: "f : cat_ordinal m' ≀C.PEOΞ± cat_ordinal n'" 
      and "m' ∈∘ A"
      and "n' ∈∘ A"
    by (elim cat_simplicial_ArrE)  
  then have 
    "cat_simplicial Ξ± A⦇Domβ¦ˆβ¦‡f⦈ = cat_ordinal m'"
    "cat_simplicial Ξ± A⦇Codβ¦ˆβ¦‡f⦈ = cat_ordinal n'"
    by (cs_concl cs_simp: cat_simplicial_cs_simps)+
  with f(2,3) have 
    "cat_ordinal m' = cat_ordinal m" "cat_ordinal n' = cat_ordinal n"
    by auto
  with f(2,3) cat_ordinal_inj have [simp]: "m' = m" "n' = n" by auto
  from f_is_preorder_functor show ?thesis by simp
qed

lemma cat_simplicial_is_arrE[elim]: 
  assumes "f : a ↦cat_simplicial Ξ± A b"
  obtains m n where "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
    and "m ∈∘ A" 
    and "n ∈∘ A"
    and "a = cat_ordinal m"
    and "b = cat_ordinal n"
proof-
  note f = is_arrD[OF assms(1)]
  from f(1) obtain m n
    where f_is_preorder_functor: "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n" 
      and m: "m ∈∘ A"
      and n: "n ∈∘ A"
    by (elim cat_simplicial_ArrE)  
  then have 
    "cat_simplicial Ξ± A⦇Domβ¦ˆβ¦‡f⦈ = cat_ordinal m"
    "cat_simplicial Ξ± A⦇Codβ¦ˆβ¦‡f⦈ = cat_ordinal n"
    by (cs_concl cs_simp: cat_simplicial_cs_simps)+
  with f(2,3) have "cat_ordinal m = a" "cat_ordinal n = b"
    by auto
  with f_is_preorder_functor m n that show ?thesis by auto
qed


subsubsectionβ€ΉCompositionβ€Ί

mk_VLambda cat_simplicial_components(5)
  |vsv cat_simplicial_Comp_vsv[cat_simplicial_cs_intros]|
  |vdomain cat_simplicial_Comp_vdomain[cat_simplicial_cs_simps]|

lemma cat_simplicial_Comp_app[cat_simplicial_cs_simps]:
  assumes "g : cat_ordinal n ↦cat_simplicial Ξ± A cat_ordinal p"
    and "f : cat_ordinal m ↦cat_simplicial Ξ± A cat_ordinal n"
    and "m ∈∘ A" 
    and "n ∈∘ A" 
    and "p ∈∘ A"
  shows "g ∘Acat_simplicial α A f = g ∘CF f"
proof- 
  note g = cat_simplicial_is_arrD[OF assms(1,4,5)]
  note f = cat_simplicial_is_arrD[OF assms(2,3,4)]
  interpret g: is_preorder_functor Ξ± β€Ήcat_ordinal nβ€Ί β€Ήcat_ordinal pβ€Ί g
    by (rule g)
  interpret f: is_preorder_functor Ξ± β€Ήcat_ordinal mβ€Ί β€Ήcat_ordinal nβ€Ί f
    by (rule f)
  have "[g, f]∘ ∈∘ composable_cat_simplicial α A"
    by 
      (
        intro composable_cat_simplicialI, rule g, rule f; 
        (intro assms refl)?
      )
  then show "g ∘Acat_simplicial α A f = g ∘CF f"
    unfolding cat_simplicial_components by (simp add: nat_omega_simps)
qed


subsubsectionβ€ΉIdentityβ€Ί

context
  fixes Ξ± A :: V
begin

mk_VLambda cat_simplicial_components(6)[where Ξ±=Ξ± and A=A]
  |vsv cat_simplicial_CId_vsv[cat_simplicial_cs_intros]|
  |vdomain 
    cat_simplicial_CId_vdomain'[
      folded cat_simplicial_components(1)[where Ξ±=Ξ± and A=A]
    ]
  |
  |app cat_simplicial_CId_app'[
    folded cat_simplicial_components(1)[where Ξ±=Ξ± and A=A]
    ]
  |

lemmas cat_simplicial_CId_vdomain[cat_simplicial_cs_simps] = 
  cat_simplicial_CId_vdomain'
lemmas cat_simplicial_CId_app[cat_simplicial_cs_simps] = 
  cat_simplicial_CId_app'

end


subsubsectionβ€ΉSimplicial category is a categoryβ€Ί

lemma (in 𝒡) category_simplicial:
  assumes "Ord A" and "A βŠ†βˆ˜ Ξ±"
  shows "category Ξ± (cat_simplicial Ξ± A)"
proof-

  show ?thesis 
  proof(intro categoryI')

    show "vfsequence (cat_simplicial Ξ± A)" unfolding cat_simplicial_def by simp
    show "vcard (cat_simplicial Ξ± A) = 6β„•"
      unfolding cat_simplicial_def by (simp add: nat_omega_simps)

    show "β„›βˆ˜ (cat_simplicial Ξ± A⦇Dom⦈) βŠ†βˆ˜ cat_simplicial Ξ± A⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold cat_simplicial_cs_simps)
      fix f assume "f ∈∘ cat_simplicial Ξ± A⦇Arr⦈"
      then obtain m n 
        where "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n" 
          and "m ∈∘ A" 
          and "n ∈∘ A"
        by (elim cat_simplicial_ArrE)
      then show "cat_simplicial Ξ± A⦇Domβ¦ˆβ¦‡f⦈ ∈∘ cat_simplicial Ξ± A⦇Obj⦈"
        by (auto simp: cat_simplicial_Dom_app' intro: cat_simplicial_ObjI)
    qed (auto simp: cat_simplicial_components)

    show "β„›βˆ˜ (cat_simplicial Ξ± A⦇Cod⦈) βŠ†βˆ˜ cat_simplicial Ξ± A⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold cat_simplicial_cs_simps)
      fix f assume "f ∈∘ cat_simplicial Ξ± A⦇Arr⦈"
      then obtain m n 
        where "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n" 
          and "m ∈∘ A" 
          and "n ∈∘ A"
        by (elim cat_simplicial_ArrE)
      then show "cat_simplicial Ξ± A⦇Codβ¦ˆβ¦‡f⦈ ∈∘ cat_simplicial Ξ± A⦇Obj⦈"
        by (auto simp: cat_simplicial_Cod_app' intro: cat_simplicial_ObjI)
    qed (auto simp: cat_simplicial_components)

    show "(gf ∈∘ π’Ÿβˆ˜ (cat_simplicial Ξ± A⦇Comp⦈)) ⟷
      (
        βˆƒg f b c a.
          gf = [g, f]∘ ∧
          g : b ↦cat_simplicial Ξ± A c ∧
          f : a ↦cat_simplicial Ξ± A b
      )"
      for gf
    proof(intro iffI; (elim exE conjE)?)
      assume "gf ∈∘ π’Ÿβˆ˜ (cat_simplicial Ξ± A⦇Comp⦈)"
      then have "gf ∈∘ composable_cat_simplicial α A"
        unfolding cat_simplicial_components by simp
      then obtain g f m n p 
        where gf_def: "gf = [g, f]∘" 
          and g: "g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p"
          and f: "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
          and m: "m ∈∘ A" 
          and n: "n ∈∘ A"
          and p: "p ∈∘ A"
        by auto
      show "βˆƒg f b c a.
        gf = [g, f]∘ ∧
        g : b ↦cat_simplicial Ξ± A c ∧
        f : a ↦cat_simplicial Ξ± A b"
      proof(intro exI conjI)
        from g n p show "g : cat_ordinal n ↦cat_simplicial Ξ± A cat_ordinal p"
          by (intro cat_simplicial_is_arrI) simp_all
        from f m n show "f : cat_ordinal m ↦cat_simplicial Ξ± A cat_ordinal n"
          by (intro cat_simplicial_is_arrI) simp_all
      qed (simp add: gf_def)
    next
      fix g f a b c assume prems:
        "gf = [g, f]∘" 
        "g : b ↦cat_simplicial Ξ± A c"
        "f : a ↦cat_simplicial Ξ± A b"
      from prems(2) obtain n p 
        where g: "g : cat_ordinal n ≀C.PEOΞ± cat_ordinal p"
          and n: "n ∈∘ A" 
          and p: "p ∈∘ A"
          and b_def: "b = cat_ordinal n" 
          and "c = cat_ordinal p"
        by auto
      from prems(3) obtain m n'
        where f: "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n'"
          and m: "m ∈∘ A" 
          and n': "n' ∈∘ A"
          and a_def: "a = cat_ordinal m" 
          and b_def': "b = cat_ordinal n'"
        by auto
      from b_def b_def' have n'n: "n' = n" by (auto simp: cat_ordinal_inj)
      show "gf ∈∘ π’Ÿβˆ˜ (cat_simplicial Ξ± A⦇Comp⦈)"
        unfolding prems(1) cat_simplicial_Comp_vdomain
        by (intro composable_cat_simplicialI, rule g, rule f[unfolded n'n])
          (simp_all add:  m n p)
    qed
    show "g ∘Acat_simplicial Ξ± A f : a ↦cat_simplicial Ξ± A c"
      if "g : b ↦cat_simplicial Ξ± A c" and "f : a ↦cat_simplicial Ξ± A b"
      for b c g a f
      using that  
      by (elim cat_simplicial_is_arrE; simp only: cat_ordinal_inj)
        (
          cs_concl 
            cs_simp: cat_simplicial_cs_simps 
            cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
        )

    show "h ∘Acat_simplicial α A g ∘Acat_simplicial α A f =
      h ∘Acat_simplicial α A (g ∘Acat_simplicial α A f)"
      if "h : c ↦cat_simplicial Ξ± A d"
        and "g : b ↦cat_simplicial Ξ± A c"
        and "f : a ↦cat_simplicial Ξ± A b"
      for c d h b g a f
      using that
      apply(elim cat_simplicial_is_arrE; simp only:)
      subgoal for m n m' n' m'' n'' (*FIXME: investigate comp_no_flatten*)
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_simplicial_cs_simps 
              cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
          )+
      done

    show "cat_simplicial Ξ± A⦇CIdβ¦ˆβ¦‡a⦈ : a ↦cat_simplicial Ξ± A a"
      if "a ∈∘ cat_simplicial Ξ± A⦇Obj⦈" for a
      using that
    proof(elim cat_simplicial_ObjE; simp only:)
      fix m assume prems: "m ∈∘ A" "cat_ordinal m ∈∘ cat_simplicial Ξ± A⦇Obj⦈"
      moreover from prems(1) assms(1) have "Ord m" by auto
      moreover from prems assms have "m βŠ†βˆ˜ Ξ±" 
        by (meson Ord_trans vsubsetI rev_vsubsetD)
      ultimately show "cat_simplicial Ξ± A⦇CIdβ¦ˆβ¦‡cat_ordinal m⦈ :
        cat_ordinal m ↦cat_simplicial Ξ± A cat_ordinal m"
        by 
          (
            cs_concl 
              cs_simp: cat_simplicial_cs_simps 
              cs_intro: 
                cat_ordinal_cs_intros 
                cat_order_cs_intros
                cat_simplicial_cs_intros
          )
    qed
    show "cat_simplicial Ξ± A⦇CIdβ¦ˆβ¦‡b⦈ ∘Acat_simplicial Ξ± A f = f"
      if "f : a ↦cat_simplicial Ξ± A b" for a b f
      using that
      by (elim cat_simplicial_is_arrE; simp only:)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_simplicial_cs_simps
            cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
        )
    show "f ∘Acat_simplicial Ξ± A cat_simplicial Ξ± A⦇CIdβ¦ˆβ¦‡b⦈ = f"
      if "f : b ↦cat_simplicial Ξ± A c" for b c f
      using that
      by (elim cat_simplicial_is_arrE; simp only:)
        (
          cs_concl
            cs_simp: cat_cs_simps cat_simplicial_cs_simps
            cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
        )
    show "cat_simplicial Ξ± A⦇Obj⦈ βŠ†βˆ˜ Vset Ξ±"
    proof(intro vsubsetI, elim cat_simplicial_ObjE; simp only:)
      fix m assume prems: "m ∈∘ A"
      then have "Ord m" using assms(1) by auto
      moreover from prems have "m ∈∘ α" using assms(2) by auto
      ultimately interpret m: cat_tiny_linear_order Ξ± β€Ήcat_ordinal mβ€Ί
        by (intro cat_tiny_linear_order_cat_ordinal)
      show "cat_ordinal m ∈∘ Vset α" by (rule m.tiny_cat_in_Vset)
    qed

    show "(β‹ƒβˆ˜a∈∘A'. β‹ƒβˆ˜b∈∘B'. Hom (cat_simplicial Ξ± A) a b) ∈∘ Vset Ξ±"
      if "A' βŠ†βˆ˜ cat_simplicial Ξ± A⦇Obj⦈"
        and "B' βŠ†βˆ˜ cat_simplicial Ξ± A⦇Obj⦈"
        and "A' ∈∘ Vset α"
        and "B' ∈∘ Vset α"
      for A' B' 
    proof-
      define Q where "Q i =
        (
          if i = 0 β‡’ VPow ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ˜ (β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈))
           | i = 1β„• β‡’ VPow 
              (((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈)) Γ—βˆ˜
              ((β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈)))
           | i = 2β„• β‡’ A'
           | i = 3β„• β‡’ B'
           | otherwise β‡’ 0
        )"
        for i
      let ?Q = 
        β€Ή{
          [fo, fa, a, b]∘ | fo fa a b.
            fo βŠ†βˆ˜ ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ˜ (β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈)) ∧
            fa βŠ†βˆ˜
              ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈)) Γ—βˆ˜
              ((β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈)) ∧
            a ∈∘ A' ∧
            b ∈∘ B'
         }β€Ί

      have QQ: "?Q βŠ† elts (∏∘i∈∘set {0, 1β„•, 2β„•, 3β„•}. Q i)"
      proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
        fix x fo fa a b assume prems: 
          "x = [fo, fa, a, b]∘"
          "fo βŠ†βˆ˜ ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ˜ (β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈))"
          "fa βŠ†βˆ˜
            ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈)) Γ—βˆ˜
            ((β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈))"
          "a ∈∘ A'"
          "b ∈∘ B'"
        show "x ∈∘ (∏∘i∈∘set {0, 1β„•, 2β„•, 3β„•}. Q i)"
        proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
          show "π’Ÿβˆ˜ x = set {[]∘, 1β„•, 2β„•, 3β„•}"
            unfolding prems(1) by (force simp: nat_omega_simps)
          fix i assume "i ∈∘ set {0, 1β„•, 2β„•, 3β„•}"
          then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί | β€Ήi = 2β„•β€Ί | β€Ήi = 3β„•β€Ί by auto
          then show "x⦇i⦈ ∈∘ Q i" 
            by cases (auto simp: Q_def prems nat_omega_simps)
        qed (auto simp: prems)
      qed
      then have small_Q[simp]: "small ?Q" by (intro down)

      have "(β‹ƒβˆ˜a∈∘A'. β‹ƒβˆ˜b∈∘B'. Hom (cat_simplicial Ξ± A) a b) βŠ†βˆ˜ set ?Q" 
      proof(intro vsubsetI in_small_setI small_Q)
        fix f assume "f ∈∘ (β‹ƒβˆ˜a∈∘A'. β‹ƒβˆ˜b∈∘B'. Hom (cat_simplicial Ξ± A) a b)"
        then obtain a b 
          where a: "a ∈∘ A'" 
            and b: "b ∈∘ B'" 
            and "f : a ↦cat_simplicial Ξ± A b"
          by auto
        then obtain m n 
          where f: "f : cat_ordinal m ≀C.PEOΞ± cat_ordinal n"
            and m: "m ∈∘ A" 
            and n: "n ∈∘ A" 
            and a_def: "a = cat_ordinal m" 
            and b_def: "b = cat_ordinal n"
          by auto
        interpret f: is_preorder_functor Ξ± β€Ήcat_ordinal mβ€Ί β€Ήcat_ordinal nβ€Ί f 
          by (rule f)
        show "f ∈ ?Q"
        proof(unfold mem_Collect_eq, intro exI conjI)
          show "f⦇ObjMap⦈ βŠ†βˆ˜ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ˜ (β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈)"
          proof(intro vsubsetI)
            fix x assume prems: "x ∈∘ f⦇ObjMap⦈"
            obtain xl xr 
              where x_def: "x = ⟨xl, xr⟩" 
                and xl: "xl ∈∘ cat_ordinal m⦇Obj⦈" 
                and xr: "xr ∈∘ (β„›βˆ˜ (f⦇ObjMap⦈))"
              by (elim f.ObjMap.vbrelation_vinE[OF prems, unfolded cat_cs_simps])
            show "x ∈∘ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ˜ (β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈)"
              unfolding x_def
            proof(standard; (intro vifunionI))
              from xr f.cf_ObjMap_vrange show "xr ∈∘ cat_ordinal n⦇Obj⦈" by auto
            qed (use a b in β€Ήauto intro: xl simp: a_def b_defβ€Ί)
          qed
          show "f⦇ArrMap⦈ βŠ†βˆ˜
            ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈)) Γ—βˆ˜
            ((β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈))"
          proof(intro vsubsetI)
            fix x assume prems: "x ∈∘ f⦇ArrMap⦈"
            obtain xl xr 
              where x_def: "x = ⟨xl, xr⟩" 
                and xl: "xl ∈∘ cat_ordinal m⦇Arr⦈" 
                and xr: "xr ∈∘ (β„›βˆ˜ (f⦇ArrMap⦈))"
              by (elim f.ArrMap.vbrelation_vinE[OF prems, unfolded cat_cs_simps])
            from xr vsubsetD have xr: "xr ∈∘ cat_ordinal n⦇Arr⦈"
              by (auto intro: f.cf_ArrMap_vrange)
            from xl obtain xll xlr where xl_def: "xl = [xll, xlr]∘" 
              and xll_m: "xll ∈∘ m" 
              and xlr_m: "xlr ∈∘ m" 
              and "xll βŠ†βˆ˜ xlr" 
              unfolding ordinal_arrs_def cat_ordinal_components by clarsimp
            from xr obtain xrl xrr where xr_def: "xr = [xrl, xrr]∘" 
              and xrl_n: "xrl ∈∘ n"
              and xrr_n:"xrr ∈∘ n"
              and "xrl βŠ†βˆ˜ xrr"
              unfolding ordinal_arrs_def cat_ordinal_components by clarsimp
            show "x ∈∘
              ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈)) Γ—βˆ˜
              ((β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈))"
              unfolding x_def
              by (standard; (intro vifunionI ftimesI1)?)
                (
                  use a b in β€Ή
                    auto
                      simp: xl_def xr_def a_def b_def cat_ordinal_components
                      intro: xrr_n xrl_n xlr_m xll_m
                    β€Ί
                )
          qed 
        qed 
          (
            auto 
              simp: cat_cs_simps 
              intro: a[unfolded a_def] b[unfolded b_def] f.cf_def
          )
      qed
      moreover have "set ?Q βŠ†βˆ˜ (∏∘i∈∘set {0, 1β„•, 2β„•, 3β„•}. Q i)"
        by 
          (
            intro vsubset_if_subset, 
            unfold small_elts_of_set[OF small_Q], 
            intro QQ
          )
      moreover have "(∏∘i∈∘set {0, 1β„•, 2β„•, 3β„•}. Q i) ∈∘ Vset Ξ±"
      proof(intro Limit_vproduct_in_VsetI)
        show "set {0, 1β„•, 2β„•, 3β„•} ∈∘ Vset Ξ±"
          unfolding four[symmetric] by simp
        have "(β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) βŠ†βˆ˜ β‹ƒβˆ˜(β‹ƒβˆ˜r∈∘A'. β„›βˆ˜ r)"
        proof(intro vsubsetI)
          fix x assume "x ∈∘ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈)"
          then obtain a' where a': "a' ∈∘ A'" and x: "x ∈∘ a'⦇Obj⦈" by auto
          from a' that(1) have "a' ∈∘ cat_simplicial Ξ± A⦇Obj⦈" by auto
          then obtain m where a'_def: "a' = cat_ordinal m" and m: "m ∈∘ A"
            unfolding cat_simplicial_components by clarsimp
          show "x ∈∘ β‹ƒβˆ˜(β‹ƒβˆ˜r∈∘A'. β„›βˆ˜ r)"
          proof(rule VUnionI, rule vifunionI)
            from a'_def have "vsv a'" and "Obj ∈∘ π’Ÿβˆ˜ a'"
              unfolding a'_def cat_ordinal_def Obj_def by auto
            then show "a'⦇Obj⦈ ∈∘ β„›βˆ˜ a'" by auto
          qed (auto simp: x a')
        qed
        moreover have "(β‹ƒβˆ˜r∈∘A'. β„›βˆ˜ r) ∈∘ Vset Ξ±"
          by (intro Limit_VUnion_vrange_in_VsetI[OF Limit_Ξ±] that)
        ultimately have UA': "(β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) ∈∘ Vset Ξ±" by blast
        have B': "(β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈) βŠ†βˆ˜ β‹ƒβˆ˜(β‹ƒβˆ˜r∈∘B'. β„›βˆ˜ r)"
          (*FIXME: code duplication*)
        proof(intro vsubsetI)
          fix x assume "x ∈∘ (β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈)"
          then obtain b' where b': "b' ∈∘ B'" and x: "x ∈∘ b'⦇Obj⦈" by auto
          from b' that(2) have "b' ∈∘ cat_simplicial Ξ± A⦇Obj⦈" by auto
          then obtain m where b'_def: "b' = cat_ordinal m" and m: "m ∈∘ A"
            unfolding cat_simplicial_components by clarsimp
          show "x ∈∘ β‹ƒβˆ˜(β‹ƒβˆ˜r∈∘B'. β„›βˆ˜ r)"
          proof(rule VUnionI, rule vifunionI)
            from b'_def have "vsv b'" and "Obj ∈∘ π’Ÿβˆ˜ b'"
              unfolding b'_def cat_ordinal_def Obj_def by auto
            then show "b'⦇Obj⦈ ∈∘ β„›βˆ˜ b'" by auto
          qed (auto simp: x b')
        qed
        moreover have "(β‹ƒβˆ˜r∈∘B'. β„›βˆ˜ r) ∈∘ Vset Ξ±"
          by (intro Limit_VUnion_vrange_in_VsetI[OF Limit_Ξ±] that)
        ultimately have UB': "(β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈) ∈∘ Vset Ξ±" by blast
        have [simp]: 
          "VPow ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ˜ (β‹ƒβˆ˜b'∈∘B'. b'⦇Obj⦈)) ∈∘ Vset Ξ±"
          by (intro Limit_VPow_in_VsetI Limit_vtimes_in_VsetI UA' UB') auto
        have [simp]:
          "VPow
            (
              ((β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘A'. a'⦇Obj⦈)) Γ—βˆ˜
              ((β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈) Γ—βˆ™ (β‹ƒβˆ˜a'∈∘B'. a'⦇Obj⦈))
            ) ∈∘ Vset α"
          by 
            (
              intro 
                Limit_VPow_in_VsetI 
                Limit_vtimes_in_VsetI 
                Limit_ftimes_in_VsetI  
                UA' UB'
            )
            auto
        fix i assume "i ∈∘ set {0, 1β„•, 2β„•, 3β„•}"
        then consider β€Ήi = 0β€Ί | β€Ήi = 1β„•β€Ί | β€Ήi = 2β„•β€Ί | β€Ήi = 3β„•β€Ί by auto
        then show "Q i ∈∘ Vset α" 
          by cases (simp_all add: Q_def that nat_omega_simps)
      qed auto
      ultimately show ?thesis by (simp add: vsubset_in_VsetI)
    qed
  qed (auto simp: cat_simplicial_components)

qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_ECAT_Structure_Example

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉExample: categories with additional structureβ€Ί
theory CZH_ECAT_Structure_Example
  imports 
    CZH_ECAT_Introduction
    CZH_ECAT_PCategory
    CZH_ECAT_Set
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The examples that are presented in this section showcase
how the framework developed in this article can 
be used for the formalization of the theory of 
categories with additional structure. The content of
this section also indicates some of the potential 
future directions for this body of work.
β€Ί



subsectionβ€ΉDagger categoryβ€Ί

named_theorems dag_field_simps

named_theorems catdag_cs_simps
named_theorems catdag_cs_intros

definition DagCat :: V where [dag_field_simps]: "DagCat = 0"
definition DagDag :: V where [dag_field_simps]: "DagDag = 1β„•"

abbreviation DagDag_app :: "V β‡’ V" (ܠCβ€Ί)
  where "†C β„­ ≑ ℭ⦇DagDag⦈"


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
For further information see
\cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/dagger+category
}}.
β€Ί

locale dagger_category =  
  𝒡 Ξ± +
  vfsequence β„­ + 
  DagCat: category Ξ± ‹ℭ⦇DagCatβ¦ˆβ€Ί +
  DagDag: is_functor Ξ± β€Ήop_cat (ℭ⦇DagCat⦈)β€Ί ‹ℭ⦇DagCatβ¦ˆβ€Ί ܠC β„­β€Ί 
  for Ξ± β„­ +
  assumes catdag_length: "vcard β„­ = 2β„•"
    and catdag_ObjMap_identity[catdag_cs_simps]: 
      "a ∈∘ ℭ⦇DagCatβ¦ˆβ¦‡Obj⦈ ⟹ (†C β„­)⦇ObjMapβ¦ˆβ¦‡a⦈ = a"
    and catdag_DagCat_idem[catdag_cs_simps]: 
      "†C β„­ CF∘ †C β„­ = cf_id (ℭ⦇DagCat⦈)"

lemmas [catdag_cs_simps] =
  dagger_category.catdag_ObjMap_identity
  dagger_category.catdag_DagCat_idem


textβ€ΉRules.β€Ί

lemma (in dagger_category) dagger_category_axioms'[cat_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "dagger_category Ξ±' β„­"
  unfolding assms by (rule dagger_category_axioms)

mk_ide rf dagger_category_def[unfolded dagger_category_axioms_def]
  |intro dagger_categoryI|
  |dest dagger_categoryD[dest]|
  |elim dagger_categoryE[elim]|

lemma category_if_dagger_category[catdag_cs_intros]:
  assumes "β„­' = (ℭ⦇DagCat⦈)" and "dagger_category Ξ± β„­"
  shows "category Ξ± β„­'"
  unfolding assms(1) using assms(2) by (rule dagger_categoryD(3))

lemma (in dagger_category) catdag_is_functor'[catdag_cs_intros]:
  assumes "𝔄' = op_cat (ℭ⦇DagCat⦈)" and "𝔅' = ℭ⦇DagCat⦈"
  shows "†C β„­ : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms by (rule DagDag.is_functor_axioms)

lemmas [catdag_cs_intros] = dagger_category.catdag_is_functor'



subsectionβ€Ήβ€ΉRelβ€Ί as a dagger categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
For further information see
\cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/Rel
}}.
β€Ί

definition dagcat_Rel :: "V β‡’ V"
  where "dagcat_Rel Ξ± = [cat_Rel Ξ±, †C.Rel Ξ±]∘"


textβ€ΉComponents.β€Ί

lemma dagcat_Rel_components:
  shows "dagcat_Rel α⦇DagCat⦈ = cat_Rel Ξ±"
    and "dagcat_Rel α⦇DagDag⦈ = †C.Rel Ξ±"
  unfolding dagcat_Rel_def dag_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€Ήβ€ΉRelβ€Ί is a dagger categoryβ€Ί

lemma (in 𝒡) "dagger_category Ξ± (dagcat_Rel Ξ±)"
proof(intro dagger_categoryI)
  show "category Ξ± (dagcat_Rel α⦇DagCat⦈)" 
    by (cs_concl cs_simp: dagcat_Rel_components cs_intro: cat_Rel_cs_intros)
  show "†C (dagcat_Rel Ξ±) :
    op_cat (dagcat_Rel α⦇DagCat⦈) ↦↦CΞ± dagcat_Rel α⦇DagCat⦈"
    unfolding dagcat_Rel_components
    by (cs_concl cs_intro: cf_cs_intros cat_cs_intros)
  show "vcard (dagcat_Rel Ξ±) = 2β„•"
    unfolding dagcat_Rel_def by (simp add: nat_omega_simps)
  show "†C (dagcat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡a⦈ = a"
    if "a ∈∘ dagcat_Rel α⦇DagCatβ¦ˆβ¦‡Obj⦈" for a
    using that
    unfolding dagcat_Rel_components cat_Rel_components(1)
    by (cs_concl cs_simp: cat_cs_simps cat_Rel_cs_simps)
  show "†C (dagcat_Rel Ξ±) CF∘ †C (dagcat_Rel Ξ±) = dghm_id (dagcat_Rel α⦇DagCat⦈)"
    unfolding dagcat_Rel_components
    by (cs_concl cs_simp: cf_cn_comp_cf_dag_Rel_cf_dag_Rel)
qed (auto simp: dagcat_Rel_def)



subsectionβ€ΉMonoidal categoryβ€Ί


textβ€Ή
For background information see Chapter 2 in \cite{etingof_tensor_2015}.
β€Ί


subsubsectionβ€ΉBackgroundβ€Ί

named_theorems mcat_field_simps

named_theorems mcat_cs_simps
named_theorems mcat_cs_intros

definition Mcat :: V where [mcat_field_simps]: "Mcat = 0"
definition Mcf :: V where [mcat_field_simps]: "Mcf = 1β„•"
definition Me :: V where [mcat_field_simps]: "Me = 2β„•"
definition MΞ± :: V where [mcat_field_simps]: "MΞ± = 3β„•"
definition Ml :: V where [mcat_field_simps]: "Ml = 4β„•"
definition Mr :: V where [mcat_field_simps]: "Mr = 5β„•"


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale monoidal_category =
  ―‹See Definition 2.2.8 in \cite{etingof_tensor_2015}.β€Ί
  𝒡 Ξ± + 
  vfsequence β„­ +
  Mcat: category Ξ± ‹ℭ⦇Mcatβ¦ˆβ€Ί +
  Mcf: is_functor Ξ± β€Ή(ℭ⦇Mcat⦈) Γ—C (ℭ⦇Mcat⦈)β€Ί ‹ℭ⦇Mcatβ¦ˆβ€Ί ‹ℭ⦇Mcfβ¦ˆβ€Ί +
  MΞ±: is_iso_ntcf
    Ξ± ‹ℭ⦇Mcat⦈^C3β€Ί ‹ℭ⦇Mcatβ¦ˆβ€Ί β€Ήcf_blcomp (ℭ⦇Mcf⦈)β€Ί β€Ήcf_brcomp (ℭ⦇Mcf⦈)β€Ί ‹ℭ⦇MΞ±β¦ˆβ€Ί +
  Ml: is_iso_ntcf
    Ξ±
    ‹ℭ⦇Mcatβ¦ˆβ€Ί
    ‹ℭ⦇Mcatβ¦ˆβ€Ί
    ‹ℭ⦇Mcfβ¦ˆβ„­β¦‡Mcat⦈,ℭ⦇Mcat⦈(ℭ⦇Me⦈,-)CFβ€Ί
    β€Ήcf_id (ℭ⦇Mcat⦈)β€Ί
    ‹ℭ⦇Mlβ¦ˆβ€Ί +
  Mr: is_iso_ntcf
    Ξ±
    ‹ℭ⦇Mcatβ¦ˆβ€Ί
    ‹ℭ⦇Mcatβ¦ˆβ€Ί
    ‹ℭ⦇Mcfβ¦ˆβ„­β¦‡Mcat⦈,ℭ⦇Mcat⦈(-,ℭ⦇Me⦈)CFβ€Ί
    β€Ήcf_id (ℭ⦇Mcat⦈)β€Ί
    ‹ℭ⦇Mrβ¦ˆβ€Ί
  for Ξ± β„­ +
  assumes mcat_length[mcat_cs_simps]: "vcard β„­ = 6β„•"
    and mcat_Me_is_obj[mcat_cs_intros]: "ℭ⦇Me⦈ ∈∘ ℭ⦇Mcatβ¦ˆβ¦‡Obj⦈"
    and mcat_pentagon:
      "⟦ 
        a ∈∘ ℭ⦇Mcatβ¦ˆβ¦‡Obj⦈;
        b ∈∘ ℭ⦇Mcatβ¦ˆβ¦‡Obj⦈;
        c ∈∘ ℭ⦇Mcatβ¦ˆβ¦‡Obj⦈;
        d ∈∘ ℭ⦇Mcatβ¦ˆβ¦‡Obj⦈
       ⟧ ⟹ 
        (ℭ⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡a⦈ βŠ—HM.Aℭ⦇Mcf⦈ ℭ⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡b, c, dβ¦ˆβˆ™) ∘Aℭ⦇Mcat⦈ 
          ℭ⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡a, b βŠ—HM.Oℭ⦇Mcf⦈ c, dβ¦ˆβˆ™ ∘Aℭ⦇Mcat⦈
            (ℭ⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡a, b, cβ¦ˆβˆ™ βŠ—HM.Aℭ⦇Mcf⦈ ℭ⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡d⦈) =
              ℭ⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡a, b, c βŠ—HM.Oℭ⦇Mcf⦈ dβ¦ˆβˆ™ ∘Aℭ⦇Mcat⦈
                ℭ⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡a βŠ—HM.Oℭ⦇Mcf⦈ b, c, dβ¦ˆβˆ™"
    and mcat_triangle[mcat_cs_simps]:
      "⟦ a ∈∘ ℭ⦇Mcatβ¦ˆβ¦‡Obj⦈; b ∈∘ ℭ⦇Mcatβ¦ˆβ¦‡Obj⦈ ⟧ ⟹
        (ℭ⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡a⦈ βŠ—HM.Aℭ⦇Mcf⦈ ℭ⦇Mlβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡b⦈) ∘Aℭ⦇Mcat⦈
          ℭ⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡a, ℭ⦇Me⦈, bβ¦ˆβˆ™ =
            (ℭ⦇Mrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡a⦈ βŠ—HM.Aℭ⦇Mcf⦈ ℭ⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡b⦈)"

lemmas [mcat_cs_intros] = monoidal_category.mcat_Me_is_obj
lemmas [mcat_cs_simps] = monoidal_category.mcat_triangle


textβ€ΉRules.β€Ί

lemma (in monoidal_category) monoidal_category_axioms'[cat_cs_intros]:
  assumes "Ξ±' = Ξ±"
  shows "monoidal_category Ξ±' β„­"
  unfolding assms by (rule monoidal_category_axioms)

mk_ide rf monoidal_category_def[unfolded monoidal_category_axioms_def]
  |intro monoidal_categoryI|
  |dest monoidal_categoryD[dest]|
  |elim monoidal_categoryE[elim]|


textβ€ΉElementary properties.β€Ί

lemma mcat_eqI:
  assumes "monoidal_category Ξ± 𝔄" 
    and "monoidal_category Ξ± 𝔅"
    and "𝔄⦇Mcat⦈ = 𝔅⦇Mcat⦈"
    and "𝔄⦇Mcf⦈ = 𝔅⦇Mcf⦈"
    and "𝔄⦇Me⦈ = 𝔅⦇Me⦈"
    and "𝔄⦇Mα⦈ = 𝔅⦇Mα⦈"
    and "𝔄⦇Ml⦈ = 𝔅⦇Ml⦈"
    and "𝔄⦇Mr⦈ = 𝔅⦇Mr⦈"
  shows "𝔄 = 𝔅"
proof-
  interpret 𝔄: monoidal_category Ξ± 𝔄 by (rule assms(1))
  interpret 𝔅: monoidal_category Ξ± 𝔅 by (rule assms(2))
  show ?thesis
  proof(rule vsv_eqI)
    have dom: "π’Ÿβˆ˜ 𝔄 = 6β„•" by (cs_concl cs_simp: mcat_cs_simps V_cs_simps)
    show "π’Ÿβˆ˜ 𝔄 = π’Ÿβˆ˜ 𝔅" by (cs_concl cs_simp: mcat_cs_simps V_cs_simps)
    show "a ∈∘ π’Ÿβˆ˜ 𝔄 ⟹ 𝔄⦇a⦈ = 𝔅⦇a⦈" for a 
      by (unfold dom, elim_in_numeral, insert assms) 
        (auto simp: mcat_field_simps)
  qed auto
qed



subsectionβ€ΉComponents for β€ΉMΞ±β€Ί for β€ΉRelβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition MΞ±_Rel_arrow_lr :: "V β‡’ V β‡’ V β‡’ V"
  where "MΞ±_Rel_arrow_lr A B C =
    [
      (Ξ»ab_c∈∘(A Γ—βˆ˜ B) Γ—βˆ˜ C. ⟨vfst (vfst ab_c), ⟨vsnd (vfst ab_c), vsnd ab_c⟩⟩),
      (A Γ—βˆ˜ B) Γ—βˆ˜ C,
      A Γ—βˆ˜ (B Γ—βˆ˜ C)
    ]∘"

definition MΞ±_Rel_arrow_rl :: "V β‡’ V β‡’ V β‡’ V"
  where "MΞ±_Rel_arrow_rl A B C =
    [
      (Ξ»a_bc∈∘A Γ—βˆ˜ (B Γ—βˆ˜ C). ⟨⟨vfst a_bc, vfst (vsnd a_bc)⟩, vsnd (vsnd a_bc)⟩),
      A Γ—βˆ˜ (B Γ—βˆ˜ C),
      (A Γ—βˆ˜ B) Γ—βˆ˜ C
    ]∘"


textβ€ΉComponents.β€Ί

lemma MΞ±_Rel_arrow_lr_components:
  shows "MΞ±_Rel_arrow_lr A B C⦇ArrVal⦈ =
    (Ξ»ab_c∈∘(A Γ—βˆ˜ B) Γ—βˆ˜ C. ⟨vfst (vfst ab_c), ⟨vsnd (vfst ab_c), vsnd ab_c⟩⟩)"
    and [cat_cs_simps]: "MΞ±_Rel_arrow_lr A B C⦇ArrDom⦈ = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and [cat_cs_simps]: "MΞ±_Rel_arrow_lr A B C⦇ArrCod⦈ = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
  unfolding MΞ±_Rel_arrow_lr_def arr_field_simps by (simp_all add: nat_omega_simps)

lemma MΞ±_Rel_arrow_rl_components:
  shows "MΞ±_Rel_arrow_rl A B C⦇ArrVal⦈ =
    (Ξ»a_bc∈∘A Γ—βˆ˜ (B Γ—βˆ˜ C). ⟨⟨vfst a_bc, vfst (vsnd a_bc)⟩, vsnd (vsnd a_bc)⟩)"
    and [cat_cs_simps]: "MΞ±_Rel_arrow_rl A B C⦇ArrDom⦈ = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and [cat_cs_simps]: "MΞ±_Rel_arrow_rl A B C⦇ArrCod⦈ = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
  unfolding MΞ±_Rel_arrow_rl_def arr_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda MΞ±_Rel_arrow_lr_components(1)
  |vsv MΞ±_Rel_arrow_lr_ArrVal_vsv[cat_cs_intros]|
  |vdomain MΞ±_Rel_arrow_lr_ArrVal_vdomain[cat_cs_simps]|
  |app MΞ±_Rel_arrow_lr_ArrVal_app'|

lemma MΞ±_Rel_arrow_lr_ArrVal_app[cat_cs_simps]:
  assumes "ab_c = ⟨⟨a, b⟩, c⟩" and "ab_c ∈∘ (A Γ—βˆ˜ B) Γ—βˆ˜ C"
  shows "MΞ±_Rel_arrow_lr A B C⦇ArrValβ¦ˆβ¦‡ab_c⦈ = ⟨a, ⟨b, c⟩⟩"
  using assms(2)
  unfolding assms(1)
  by (simp_all add: MΞ±_Rel_arrow_lr_ArrVal_app' nat_omega_simps)

mk_VLambda MΞ±_Rel_arrow_rl_components(1)
  |vsv MΞ±_Rel_arrow_rl_ArrVal_vsv[cat_cs_intros]|
  |vdomain MΞ±_Rel_arrow_rl_ArrVal_vdomain[cat_cs_simps]|
  |app MΞ±_Rel_arrow_rl_ArrVal_app'|

lemma MΞ±_Rel_arrow_rl_ArrVal_app[cat_cs_simps]:
  assumes "a_bc = ⟨a, ⟨b, c⟩⟩" and "a_bc ∈∘ A Γ—βˆ˜ (B Γ—βˆ˜ C)"
  shows "MΞ±_Rel_arrow_rl A B C⦇ArrValβ¦ˆβ¦‡a_bc⦈ = ⟨⟨a, b⟩, c⟩"
  using assms(2)
  unfolding assms(1)
  by (simp_all add: MΞ±_Rel_arrow_rl_ArrVal_app' nat_omega_simps)


subsubsectionβ€ΉComponents for β€ΉMΞ±β€Ί for β€ΉRelβ€Ί are arrowsβ€Ί

lemma (in 𝒡) MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset: 
  assumes "A ∈∘ Vset α" and "B ∈∘ Vset α" and "C ∈∘ Vset α"
  shows "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Set Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
proof(intro cat_Set_is_arrI arr_SetI)
  show "vfsequence (MΞ±_Rel_arrow_lr A B C)" unfolding MΞ±_Rel_arrow_lr_def by auto
  show "vcard (MΞ±_Rel_arrow_lr A B C) = 3β„•"
    unfolding MΞ±_Rel_arrow_lr_def by (simp add: nat_omega_simps)
  show "β„›βˆ˜ (MΞ±_Rel_arrow_lr A B C⦇ArrVal⦈) βŠ†βˆ˜ MΞ±_Rel_arrow_lr A B C⦇ArrCod⦈"
    unfolding MΞ±_Rel_arrow_lr_components by auto
qed
  (
    use assms in 
      β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_introsβ€Ί
  )+

lemma (in 𝒡) MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset: 
  assumes "A ∈∘ Vset α" and "B ∈∘ Vset α" and "C ∈∘ Vset α"
  shows "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦cat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
proof(intro cat_Set_is_arrI arr_SetI)
  show "vfsequence (MΞ±_Rel_arrow_rl A B C)" unfolding MΞ±_Rel_arrow_rl_def by auto
  show "vcard (MΞ±_Rel_arrow_rl A B C) = 3β„•"
    unfolding MΞ±_Rel_arrow_rl_def by (simp add: nat_omega_simps)
  show "β„›βˆ˜ (MΞ±_Rel_arrow_rl A B C⦇ArrVal⦈) βŠ†βˆ˜ MΞ±_Rel_arrow_rl A B C⦇ArrCod⦈"
    unfolding MΞ±_Rel_arrow_rl_components by auto
qed
  (
    use assms in 
      β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_introsβ€Ί
  )+

lemma (in 𝒡) MΞ±_Rel_arrow_lr_is_cat_Set_arr: 
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
  shows "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Set Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
  using assms 
  unfolding cat_Set_components 
  by (rule MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset)

lemma (in 𝒡) MΞ±_Rel_arrow_lr_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]: 
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
    and "A' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "B' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "β„­' = cat_Set Ξ±"
  shows "MΞ±_Rel_arrow_lr A B C : A' ↦ℭ' B'"
  using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_lr_is_cat_Set_arr)

lemmas [cat_rel_par_Set_cs_intros] = 𝒡.MΞ±_Rel_arrow_lr_is_cat_Set_arr'

lemma (in 𝒡) MΞ±_Rel_arrow_rl_is_cat_Set_arr: 
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
  shows "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦cat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
  using assms 
  unfolding cat_Set_components 
  by (rule MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset)

lemma (in 𝒡) MΞ±_Rel_arrow_rl_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]: 
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
    and "A' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "B' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "β„­' = cat_Set Ξ±"
  shows "MΞ±_Rel_arrow_rl A B C : A' ↦ℭ' B'"
  using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_rl_is_cat_Set_arr)

lemmas [cat_rel_par_Set_cs_intros] = 𝒡.MΞ±_Rel_arrow_rl_is_cat_Set_arr'

lemma (in 𝒡) MΞ±_Rel_arrow_lr_is_cat_Par_arr:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈" 
    and "C ∈∘ cat_Par α⦇Obj⦈"
  shows "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Par Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  from assms show ?thesis
    unfolding cat_Par_components(1)
    by (intro Set_Par.subcat_is_arrD MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) MΞ±_Rel_arrow_lr_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈" 
    and "C ∈∘ cat_Par α⦇Obj⦈"
    and "A' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "B' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "β„­' = cat_Par Ξ±"
  shows "MΞ±_Rel_arrow_lr A B C : A' ↦ℭ' B'"
  using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_lr_is_cat_Par_arr)

lemmas [cat_rel_Par_set_cs_intros] = 𝒡.MΞ±_Rel_arrow_lr_is_cat_Par_arr'

lemma (in 𝒡) MΞ±_Rel_arrow_rl_is_cat_Par_arr:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈" 
    and "C ∈∘ cat_Par α⦇Obj⦈"
  shows "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦cat_Par Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  from assms show ?thesis
    unfolding cat_Par_components(1)
    by (intro Set_Par.subcat_is_arrD MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) MΞ±_Rel_arrow_rl_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈" 
    and "C ∈∘ cat_Par α⦇Obj⦈"
    and "A' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "B' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "β„­' = cat_Par Ξ±"
  shows "MΞ±_Rel_arrow_rl A B C : A' ↦ℭ' B'"
  using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_rl_is_cat_Par_arr)

lemmas [cat_rel_Par_set_cs_intros] = 𝒡.MΞ±_Rel_arrow_rl_is_cat_Par_arr'

lemma (in 𝒡) MΞ±_Rel_arrow_lr_is_cat_Rel_arr:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈" 
    and "C ∈∘ cat_Rel α⦇Obj⦈"
  shows "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Rel Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule subcat_trans[
          OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
          ]
      )
  from assms show ?thesis
    unfolding cat_Rel_components(1)
    by (intro Set_Rel.subcat_is_arrD MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) MΞ±_Rel_arrow_lr_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈" 
    and "C ∈∘ cat_Rel α⦇Obj⦈"
    and "A' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "B' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "β„­' = cat_Rel Ξ±"
  shows "MΞ±_Rel_arrow_lr A B C : A' ↦ℭ' B'"
  using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_lr_is_cat_Rel_arr)

lemmas [cat_Rel_par_set_cs_intros] = 𝒡.MΞ±_Rel_arrow_lr_is_cat_Rel_arr'

lemma (in 𝒡) MΞ±_Rel_arrow_rl_is_cat_Rel_arr:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈" 
    and "C ∈∘ cat_Rel α⦇Obj⦈"
  shows "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦cat_Rel Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule subcat_trans[
          OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
          ]
      )
  from assms show ?thesis
    unfolding cat_Rel_components(1)
    by (intro Set_Rel.subcat_is_arrD MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset) auto
qed

lemma (in 𝒡) MΞ±_Rel_arrow_rl_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈" 
    and "C ∈∘ cat_Rel α⦇Obj⦈"
    and "A' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "B' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "β„­' = cat_Rel Ξ±"
  shows "MΞ±_Rel_arrow_rl A B C : A' ↦ℭ' B'"
  using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_rl_is_cat_Rel_arr)

lemmas [cat_Rel_par_set_cs_intros] = 𝒡.MΞ±_Rel_arrow_rl_is_cat_Rel_arr'


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in 𝒡) MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr[cat_cs_simps]:
  assumes "A ∈∘ Vset α" and "B ∈∘ Vset α" and "C ∈∘ Vset α"
  shows 
    "Mα_Rel_arrow_rl A B C ∘Acat_Set α Mα_Rel_arrow_lr A B C = 
      cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ C⦈"
proof-
  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (cs_concl cs_intro: cat_cs_intros)
  from assms have lhs:
    "Mα_Rel_arrow_rl A B C ∘Acat_Set α Mα_Rel_arrow_lr A B C :
      (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by 
      (
        cs_concl
          cs_simp: cat_Set_components(1)
          cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros
      )
  then have dom_lhs:
    "π’Ÿβˆ˜ ((MΞ±_Rel_arrow_rl A B C ∘Acat_Set Ξ± MΞ±_Rel_arrow_lr A B C)⦇ArrVal⦈) =
      (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms Set.category_axioms have rhs:
    "cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ C⦈ :
      (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by 
      (
        cs_concl 
          cs_simp: cat_Set_components(1) cs_intro: V_cs_intros cat_cs_intros
      )
  then have dom_rhs: 
    "π’Ÿβˆ˜ ((cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ C⦈)⦇ArrVal⦈) = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show ?thesis
  proof(rule arr_Set_eqI)
    from lhs show arr_Set_lhs:
      "arr_Set α (Mα_Rel_arrow_rl A B C ∘Acat_Set α Mα_Rel_arrow_lr A B C)"
      by (auto dest: cat_Set_is_arrD(1))
    from rhs show arr_Set_rhs: "arr_Set Ξ± (cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ C⦈)"
      by (auto dest: cat_Set_is_arrD(1))
    show 
      "(MΞ±_Rel_arrow_rl A B C ∘Acat_Set Ξ± MΞ±_Rel_arrow_lr A B C)⦇ArrVal⦈ = 
        cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ Cβ¦ˆβ¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix ab_c assume prems: "ab_c ∈∘ (A Γ—βˆ˜ B) Γ—βˆ˜ C"
      then obtain a b c
        where ab_c_def: "ab_c = ⟨⟨a, b⟩, c⟩"
          and a: "a ∈∘ A"
          and b: "b ∈∘ B"
          and c: "c ∈∘ C"
        by clarsimp
      from assms prems a b c lhs rhs show 
        "(MΞ±_Rel_arrow_rl A B C ∘Acat_Set Ξ± MΞ±_Rel_arrow_lr A B C)⦇ArrValβ¦ˆβ¦‡ab_c⦈ = 
          cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ Cβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡ab_c⦈"
        unfolding ab_c_def
        by
          (
            cs_concl
              cs_simp: cat_Set_components(1) cat_cs_simps
              cs_intro: cat_rel_par_Set_cs_intros V_cs_intros cat_cs_intros
          )
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
qed

lemma (in 𝒡) MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr'[cat_cs_simps]:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
  shows 
    "Mα_Rel_arrow_rl A B C ∘Acat_Set α Mα_Rel_arrow_lr A B C = 
      cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ C⦈"
  using assms unfolding cat_Set_components(1) by (rule MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr)

lemmas [cat_cs_simps] = 𝒡.MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr'

lemma (in 𝒡) MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl[cat_cs_simps]:
  assumes "A ∈∘ Vset α" and "B ∈∘ Vset α" and "C ∈∘ Vset α"
  shows 
    "Mα_Rel_arrow_lr A B C ∘Acat_Set α Mα_Rel_arrow_rl A B C = 
      cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ (B Γ—βˆ˜ C)⦈"
proof-
  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (cs_concl cs_intro: cat_cs_intros)
  from assms have lhs:
    "Mα_Rel_arrow_lr A B C ∘Acat_Set α Mα_Rel_arrow_rl A B C :
      A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦cat_Set Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    by 
      (
        cs_concl 
          cs_simp: cat_Set_components(1) 
          cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros
      )
  then have dom_lhs:
    "π’Ÿβˆ˜ ((MΞ±_Rel_arrow_lr A B C ∘Acat_Set Ξ± MΞ±_Rel_arrow_rl A B C)⦇ArrVal⦈) =
      A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms Set.category_axioms have rhs:
    "cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ (B Γ—βˆ˜ C)⦈ :
      A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦cat_Set Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    by 
      (
        cs_concl 
          cs_simp: cat_Set_components(1) cs_intro: V_cs_intros cat_cs_intros
      )
  then have dom_rhs: 
    "π’Ÿβˆ˜ ((cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ (B Γ—βˆ˜ C)⦈)⦇ArrVal⦈) = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show ?thesis
  proof(rule arr_Set_eqI)
    from lhs show arr_Set_lhs:
      "arr_Set α (Mα_Rel_arrow_lr A B C ∘Acat_Set α Mα_Rel_arrow_rl A B C)"
      by (auto dest: cat_Set_is_arrD(1))
    from rhs show arr_Set_rhs: "arr_Set Ξ± (cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ (B Γ—βˆ˜ C)⦈)"
      by (auto dest: cat_Set_is_arrD(1))
    show 
      "(MΞ±_Rel_arrow_lr A B C ∘Acat_Set Ξ± MΞ±_Rel_arrow_rl A B C)⦇ArrVal⦈ = 
        cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ (B Γ—βˆ˜ C)β¦ˆβ¦‡ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a_bc assume prems: "a_bc ∈∘ A Γ—βˆ˜ (B Γ—βˆ˜ C)"
      then obtain a b c
        where a_bc_def: "a_bc = ⟨a, ⟨b, c⟩⟩"
          and a: "a ∈∘ A"
          and b: "b ∈∘ B"
          and c: "c ∈∘ C"
        by clarsimp
      from assms prems a b c lhs rhs show 
        "(MΞ±_Rel_arrow_lr A B C ∘Acat_Set Ξ± MΞ±_Rel_arrow_rl A B C)⦇ArrValβ¦ˆβ¦‡a_bc⦈ = 
          cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ (B Γ—βˆ˜ C)β¦ˆβ¦‡ArrValβ¦ˆβ¦‡a_bc⦈"
        unfolding a_bc_def
        by
          (
            cs_concl
              cs_simp: cat_Set_components(1) cat_cs_simps
              cs_intro: V_cs_intros cat_rel_par_Set_cs_intros cat_cs_intros
          )
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
qed

lemma (in 𝒡) MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl'[cat_cs_simps]:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
  shows 
    "Mα_Rel_arrow_lr A B C ∘Acat_Set α Mα_Rel_arrow_rl A B C = 
      cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ (B Γ—βˆ˜ C)⦈"
  using assms 
  unfolding cat_Set_components(1) 
  by (rule MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl)

lemmas [cat_cs_simps] = 𝒡.MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl'


subsubsectionβ€ΉComponents for β€ΉMΞ±β€Ί for β€ΉRelβ€Ί are isomorphismsβ€Ί

lemma (in 𝒡) 
  assumes "A ∈∘ Vset α" and "B ∈∘ Vset α" and "C ∈∘ Vset α"
  shows MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset: 
    "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦isocat_Set Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset:
    "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦isocat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
proof-
  interpret Set: category Ξ± β€Ήcat_Set Ξ±β€Ί by (cs_concl cs_intro: cat_cs_intros)
  have lhs: "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦cat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by (intro MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset assms)
  from assms have [cat_cs_simps]:
    "Mα_Rel_arrow_rl A B C ∘Acat_Set α Mα_Rel_arrow_lr A B C =
      cat_Set α⦇CIdβ¦ˆβ¦‡(A Γ—βˆ˜ B) Γ—βˆ˜ C⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_Set_components(1) cat_cs_simps cs_intro: cat_cs_intros
      )
  from assms have [cat_cs_simps]: 
    "Mα_Rel_arrow_lr A B C ∘Acat_Set α Mα_Rel_arrow_rl A B C =
      cat_Set α⦇CIdβ¦ˆβ¦‡A Γ—βˆ˜ B Γ—βˆ˜ C⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_Set_components(1) cat_cs_simps cs_intro: cat_cs_intros
      )
  from 
    Set.is_arr_isomorphismI'
      [
        OF lhs MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset[OF assms], 
        unfolded cat_cs_simps,
        simplified
      ]
  show "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦isocat_Set Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦isocat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by auto
qed

lemma (in 𝒡) 
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
  shows MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism:
    "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦isocat_Set Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism:
    "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦isocat_Set Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
  using assms
  unfolding cat_Set_components(1)
  by
    (
      all
        β€Ή
          intro
            MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset
            MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset
        β€Ί
    )

lemma (in 𝒡) 
  MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
    and "A' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "B' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "β„­' = cat_Set Ξ±"
  shows "MΞ±_Rel_arrow_lr A B C : A' ↦isoβ„­' B'"
  using assms(1-3) 
  unfolding assms(4-6) 
  by (rule MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism)

lemmas [cat_rel_par_Set_cs_intros] = 
  𝒡.MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism'

lemma (in 𝒡) 
  MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
  assumes "A ∈∘ cat_Set α⦇Obj⦈" 
    and "B ∈∘ cat_Set α⦇Obj⦈" 
    and "C ∈∘ cat_Set α⦇Obj⦈"
    and "A' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "B' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "β„­' = cat_Set Ξ±"
  shows "MΞ±_Rel_arrow_rl A B C : A' ↦isoβ„­' B'"
  using assms(1-3) 
  unfolding assms(4-6)
  by (rule MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism)

lemmas [cat_rel_par_Set_cs_intros] = 
  𝒡.MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism'

lemma (in 𝒡) 
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈" 
    and "C ∈∘ cat_Par α⦇Obj⦈"
  shows MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism: 
    "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦isocat_Par Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism: 
    "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦isocat_Par Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  show "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦isocat_Par Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    by 
      (
        rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Par_components]
              ]
          ]
      )
  show "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦isocat_Par Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by 
      (
        rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Par_components]
              ]
          ]
      )
qed

lemma (in 𝒡) 
  MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈" 
    and "C ∈∘ cat_Par α⦇Obj⦈"
    and "A' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "B' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "β„­' = cat_Par Ξ±"
  shows "MΞ±_Rel_arrow_lr A B C : A' ↦isoβ„­' B'"
  using assms(1-3) 
  unfolding assms(4-6) 
  by (rule MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism)

lemmas [cat_rel_Par_set_cs_intros] = 
  𝒡.MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism'

lemma (in 𝒡) 
  MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
  assumes "A ∈∘ cat_Par α⦇Obj⦈" 
    and "B ∈∘ cat_Par α⦇Obj⦈" 
    and "C ∈∘ cat_Par α⦇Obj⦈"
    and "A' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "B' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "β„­' = cat_Par Ξ±"
  shows "MΞ±_Rel_arrow_rl A B C : A' ↦isoβ„­' B'"
  using assms(1-3) 
  unfolding assms(4-6)
  by (rule MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism)

lemmas [cat_rel_Par_set_cs_intros] = 
  𝒡.MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism'

lemma (in 𝒡) 
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈" 
    and "C ∈∘ cat_Rel α⦇Obj⦈"
  shows MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism: 
    "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦isocat_Rel Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism: 
    "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦isocat_Rel Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
proof-
  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule wr_subcat_trans
          [
            OF 
              Set_Par.wide_replete_subcategory_axioms
              Par_Rel.wide_replete_subcategory_axioms
          ]
      )
  show "MΞ±_Rel_arrow_lr A B C : (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦isocat_Rel Ξ± A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    by 
      (
        rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Rel_components]
              ]
          ]
      )
  show "MΞ±_Rel_arrow_rl A B C : A Γ—βˆ˜ (B Γ—βˆ˜ C) ↦isocat_Rel Ξ± (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    by 
      (
        rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
          [
            THEN iffD1, 
            OF MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset[
              OF assms[unfolded cat_Rel_components]
              ]
          ]
      )
qed

lemma (in 𝒡) 
  MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈" 
    and "C ∈∘ cat_Rel α⦇Obj⦈"
    and "A' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "B' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "β„­' = cat_Rel Ξ±"
  shows "MΞ±_Rel_arrow_lr A B C : A' ↦isoβ„­' B'"
  using assms(1-3) 
  unfolding assms(4-6) 
  by (rule MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism)

lemmas [cat_Rel_par_set_cs_intros] =
  𝒡.MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism'

lemma (in 𝒡) 
  MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
  assumes "A ∈∘ cat_Rel α⦇Obj⦈" 
    and "B ∈∘ cat_Rel α⦇Obj⦈" 
    and "C ∈∘ cat_Rel α⦇Obj⦈"
    and "A' = A Γ—βˆ˜ (B Γ—βˆ˜ C)"
    and "B' = (A Γ—βˆ˜ B) Γ—βˆ˜ C"
    and "β„­' = cat_Rel Ξ±"
  shows "MΞ±_Rel_arrow_rl A B C : A' ↦isoβ„­' B'"
  using assms(1-3) 
  unfolding assms(4-6)
  by (rule MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism)

lemmas [cat_Rel_par_set_cs_intros] = 
  𝒡.MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'



subsectionβ€Ήβ€ΉMΞ±β€Ί for β€ΉRelβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition MΞ±_Rel :: "V β‡’ V"
  where "MΞ±_Rel β„­ =
    [
      (Ξ»abc∈∘(β„­^C3)⦇Obj⦈. MΞ±_Rel_arrow_lr (abc⦇0⦈) (abc⦇1β„•β¦ˆ) (abc⦇2β„•β¦ˆ)),
      cf_blcomp (cf_prod_2_Rel β„­),
      cf_brcomp (cf_prod_2_Rel β„­),
      β„­^C3,
      β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma MΞ±_Rel_components:
  shows "MΞ±_Rel ℭ⦇NTMap⦈ =
    (Ξ»abc∈∘(β„­^C3)⦇Obj⦈. MΞ±_Rel_arrow_lr (abc⦇0⦈) (abc⦇1β„•β¦ˆ) (abc⦇2β„•β¦ˆ))"
    and [cat_cs_simps]: "MΞ±_Rel ℭ⦇NTDom⦈ = cf_blcomp (cf_prod_2_Rel β„­)"
    and [cat_cs_simps]: "MΞ±_Rel ℭ⦇NTCod⦈ = cf_brcomp (cf_prod_2_Rel β„­)"
    and [cat_cs_simps]: "MΞ±_Rel ℭ⦇NTDGDom⦈ = β„­^C3"
    and [cat_cs_simps]: "MΞ±_Rel ℭ⦇NTDGCod⦈ = β„­"
  unfolding MΞ±_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda MΞ±_Rel_components(1)
  |vsv MΞ±_Rel_NTMap_vsv[cat_cs_intros]|
  |vdomain MΞ±_Rel_NTMap_vdomain[cat_cs_simps]|
  |app MΞ±_Rel_NTMap_app'|

lemma MΞ±_Rel_NTMap_app[cat_cs_simps]: 
  assumes "ABC = [A, B, C]∘" and "ABC ∈∘ (β„­^C3)⦇Obj⦈"
  shows "MΞ±_Rel ℭ⦇NTMapβ¦ˆβ¦‡ABC⦈ = MΞ±_Rel_arrow_lr A B C"
  using assms(2) 
  unfolding assms(1) 
  by (simp add: MΞ±_Rel_NTMap_app' nat_omega_simps)


subsubsectionβ€Ήβ€ΉMΞ±β€Ί for β€ΉRelβ€Ί is a natural isomorphismβ€Ί

lemma (in 𝒡) MΞ±_Rel_is_iso_ntcf: 
  "MΞ±_Rel (cat_Rel Ξ±) :
    cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±)) ↦CF.iso
    cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±)) :
    cat_Rel Ξ±^C3 ↦↦CΞ± cat_Rel Ξ±"
proof-

  interpret cf_prod: is_functor 
    Ξ± β€Ήcat_Rel Ξ± Γ—C cat_Rel Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί β€Ήcf_prod_2_Rel (cat_Rel Ξ±)β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)

  show ?thesis
  proof(intro is_iso_ntcfI is_ntcfI')

    show "vfsequence (MΞ±_Rel (cat_Rel Ξ±))" unfolding MΞ±_Rel_def by auto
    show "vcard (MΞ±_Rel (cat_Rel Ξ±)) = 5β„•"
      unfolding MΞ±_Rel_def by (simp add: nat_omega_simps)

    show "MΞ±_Rel (cat_Rel Ξ±)⦇NTMapβ¦ˆβ¦‡ABC⦈ :
      cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))⦇ObjMapβ¦ˆβ¦‡ABC⦈ ↦isocat_Rel Ξ±
      cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))⦇ObjMapβ¦ˆβ¦‡ABC⦈"
      if "ABC ∈∘ (cat_Rel Ξ±^C3)⦇Obj⦈" for ABC
    proof-
      from that category_cat_Rel obtain A B C 
        where ABC_def: "ABC = [A, B, C]∘"
          and A: "A ∈∘ cat_Rel α⦇Obj⦈" 
          and B: "B ∈∘ cat_Rel α⦇Obj⦈" 
          and C: "C ∈∘ cat_Rel α⦇Obj⦈"
        by (elim cat_prod_3_ObjE[rotated 3])
      from that A B C show ?thesis
        unfolding ABC_def
        by
          (
            cs_concl
              cs_intro:
                cat_cs_intros cat_Rel_par_set_cs_intros cat_prod_cs_intros
              cs_simp: cat_cs_simps cat_Rel_cs_simps
          )
    qed
    then show "MΞ±_Rel (cat_Rel Ξ±)⦇NTMapβ¦ˆβ¦‡ABC⦈ :
      cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))⦇ObjMapβ¦ˆβ¦‡ABC⦈ ↦cat_Rel Ξ±
      cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))⦇ObjMapβ¦ˆβ¦‡ABC⦈"
      if "ABC ∈∘ (cat_Rel Ξ±^C3)⦇Obj⦈" for ABC
      using that by (simp add: cat_Rel_is_arr_isomorphismD(1))
    show 
      "MΞ±_Rel (cat_Rel Ξ±)⦇NTMapβ¦ˆβ¦‡ABC'⦈ ∘Acat_Rel Ξ±
        cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))⦇ArrMapβ¦ˆβ¦‡HGF⦈ =
          cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))⦇ArrMapβ¦ˆβ¦‡HGF⦈ ∘Acat_Rel Ξ±
            MΞ±_Rel (cat_Rel Ξ±)⦇NTMapβ¦ˆβ¦‡ABC⦈"
      if "HGF : ABC ↦cat_Rel Ξ±^C3 ABC'" for ABC ABC' HGF
    proof-

      from that obtain H G F A B C A' B' C' 
        where HGF_def: "HGF = [H, G, F]∘"
          and ABC_def: "ABC = [A, B, C]∘"
          and ABC'_def: "ABC' = [A', B', C']∘" 
          and H_is_arr: "H : A ↦cat_Rel Ξ± A'"
          and G_is_arr: "G : B ↦cat_Rel Ξ± B'"
          and F_is_arr: "F : C ↦cat_Rel Ξ± C'"
        by 
          (
            elim cat_prod_3_is_arrE[
              OF category_cat_Rel category_cat_Rel category_cat_Rel 
              ]
          )

      note H = cat_Rel_is_arrD[OF H_is_arr]
      note G = cat_Rel_is_arrD[OF G_is_arr]
      note F = cat_Rel_is_arrD[OF F_is_arr]

      interpret H: arr_Rel Ξ± H
        rewrites "H⦇ArrDom⦈ = A" and "H⦇ArrCod⦈ = A'"
        by (intro H)+
      interpret G: arr_Rel Ξ± G
        rewrites "G⦇ArrDom⦈ = B" and "G⦇ArrCod⦈ = B'"
        by (intro G)+
      interpret F: arr_Rel Ξ± F
        rewrites "F⦇ArrDom⦈ = C" and "F⦇ArrCod⦈ = C'"
        by (intro F)+

      let ?ABC' = β€ΉMΞ±_Rel_arrow_lr A' B' C'β€Ί
        and ?ABC = β€ΉMΞ±_Rel_arrow_lr A B Cβ€Ί
        and ?HG_F = 
          β€Ή
            prod_2_Rel_ArrVal
              (prod_2_Rel_ArrVal (H⦇ArrVal⦈) (G⦇ArrVal⦈)) 
              (F⦇ArrVal⦈)
          β€Ί
        and ?H_GF = 
          β€Ή
            prod_2_Rel_ArrVal
              (H⦇ArrVal⦈)
              (prod_2_Rel_ArrVal (G⦇ArrVal⦈) (F⦇ArrVal⦈))
          β€Ί

      have [cat_cs_simps]:
        "?ABC' ∘Acat_Rel α prod_2_Rel (prod_2_Rel H G) F =
          prod_2_Rel H (prod_2_Rel G F) ∘Acat_Rel α ?ABC"
      proof-

        from H_is_arr G_is_arr F_is_arr have lhs:
          "?ABC' ∘Acat_Rel α prod_2_Rel (prod_2_Rel H G) F :
            (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Rel Ξ± A' Γ—βˆ˜ (B' Γ—βˆ˜ C')"
          by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
        from H_is_arr G_is_arr F_is_arr have rhs:
          "prod_2_Rel H (prod_2_Rel G F) ∘Acat_Rel α ?ABC :
            (A Γ—βˆ˜ B) Γ—βˆ˜ C ↦cat_Rel Ξ± A' Γ—βˆ˜ (B' Γ—βˆ˜ C')"
          by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
        
        show ?thesis
        proof(rule arr_Rel_eqI)

          from lhs show arr_Rel_lhs: 
            "arr_Rel α (?ABC' ∘Acat_Rel α prod_2_Rel (prod_2_Rel H G) F)"
            by (auto dest: cat_Rel_is_arrD)
          from rhs show arr_Rel_rhs: 
            "arr_Rel α (prod_2_Rel H (prod_2_Rel G F) ∘Acat_Rel α ?ABC)"
            by (auto dest: cat_Rel_is_arrD)

          have [cat_cs_simps]: "?ABC'⦇ArrVal⦈ ∘∘ ?HG_F = ?H_GF ∘∘ ?ABC⦇ArrVal⦈"
          proof(intro vsubset_antisym vsubsetI)
            fix abc_abc'' assume prems: "abc_abc'' ∈∘ ?ABC'⦇ArrVal⦈ ∘∘ ?HG_F"
            then obtain abc abc' abc'' 
              where abc_abc''_def: "abc_abc'' = ⟨abc, abc''⟩"
                and abc_abc': "⟨abc, abc'⟩ ∈∘ ?HG_F"
                and abc'_abc'': "⟨abc', abc''⟩ ∈∘ ?ABC'⦇ArrVal⦈"
              by clarsimp
            from abc_abc' obtain ab c ab' c' 
              where abc_abc'_def: "⟨abc, abc'⟩ = ⟨⟨ab, c⟩, ⟨ab', c'⟩⟩"
                and ab_ab':
                  "⟨ab, ab'⟩ ∈∘ prod_2_Rel_ArrVal (H⦇ArrVal⦈) (G⦇ArrVal⦈)"
                and cc': "⟨c, c'⟩ ∈∘ F⦇ArrVal⦈"
              by auto
            then have abc_def: "abc = ⟨ab, c⟩" and abc'_def: "abc' = ⟨ab', c'⟩" 
              by auto
            from ab_ab' obtain a b a' b'
              where ab_ab'_def: "⟨ab, ab'⟩ = ⟨⟨a, b⟩, ⟨a', b'⟩⟩"
                and aa': "⟨a, a'⟩ ∈∘ H⦇ArrVal⦈"
                and bb': "⟨b, b'⟩ ∈∘ G⦇ArrVal⦈"
              by auto
            then have ab_def: "ab = ⟨a, b⟩" and ab'_def: "ab' = ⟨a', b'⟩"  
              by auto
            from cc' F.arr_Rel_ArrVal_vdomain F.arr_Rel_ArrVal_vrange 
            have c: "c ∈∘ C" and c': "c' ∈∘ C'"
              by auto
            from bb' G.arr_Rel_ArrVal_vdomain G.arr_Rel_ArrVal_vrange 
            have b: "b ∈∘ B" and b': "b' ∈∘ B'"
              by auto
            from aa' H.arr_Rel_ArrVal_vdomain H.arr_Rel_ArrVal_vrange 
            have a: "a ∈∘ A" and a': "a' ∈∘ A'"
              by auto
            from abc'_abc'' have "abc'' = ?ABC'⦇ArrValβ¦ˆβ¦‡abc'⦈"
              by (simp add: vsv.vsv_appI[OF MΞ±_Rel_arrow_lr_ArrVal_vsv])
            also from a' b' c' have "… = ⟨a', ⟨b', c'⟩⟩"
              unfolding abc'_def ab'_def
              by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
            finally have abc''_def: "abc'' = ⟨a', ⟨b', c'⟩⟩" by auto
            from aa' bb' cc' a a' b b' c c' show 
              "abc_abc'' ∈∘ ?H_GF ∘∘ ?ABC⦇ArrVal⦈"
              unfolding abc_abc''_def abc_def abc'_def abc''_def ab'_def ab_def
              by (intro vcompI prod_2_Rel_ArrValI)
                (
                  cs_concl 
                    cs_simp: cat_cs_simps 
                    cs_intro: 
                      vsv.vsv_ex1_app2[THEN iffD1] 
                      V_cs_intros 
                      cat_cs_intros 
                      cat_Rel_cs_intros
                )+
          next
            fix abc_abc'' assume prems: "abc_abc'' ∈∘ ?H_GF ∘∘ ?ABC⦇ArrVal⦈"
            then obtain abc abc' abc'' 
              where abc_abc''_def: "abc_abc'' = ⟨abc, abc''⟩"
                and abc_abc': "⟨abc, abc'⟩ ∈∘ ?ABC⦇ArrVal⦈"
                and abc'_abc'': "⟨abc', abc''⟩ ∈∘ ?H_GF"
              by clarsimp
            from abc'_abc'' obtain a' bc' a'' bc'' 
              where abc'_abc''_def: "⟨abc', abc''⟩ = ⟨⟨a', bc'⟩, ⟨a'', bc''⟩⟩"
                and aa'': "⟨a', a''⟩ ∈∘ H⦇ArrVal⦈"
                and bc'_bc'':
                  "⟨bc', bc''⟩ ∈∘ prod_2_Rel_ArrVal (G⦇ArrVal⦈) (F⦇ArrVal⦈)"
              by auto
            then have abc'_def: "abc' = ⟨a', bc'⟩" 
              and abc''_def: "abc'' = ⟨a'', bc''⟩" 
              by auto
            from bc'_bc'' obtain b' c' b'' c''
              where bc'_bc''_def: "⟨bc', bc''⟩ = ⟨⟨b', c'⟩, ⟨b'', c''⟩⟩"
                and bb'': "⟨b', b''⟩ ∈∘ G⦇ArrVal⦈"
                and cc'': "⟨c', c''⟩ ∈∘ F⦇ArrVal⦈"
              by auto
            then have bc'_def: "bc' = ⟨b', c'⟩" 
              and bc''_def: "bc'' = ⟨b'', c''⟩"  
              by auto
            from cc'' F.arr_Rel_ArrVal_vdomain F.arr_Rel_ArrVal_vrange 
            have c': "c' ∈∘ C" and c'': "c'' ∈∘ C'"
              by auto
            from bb'' G.arr_Rel_ArrVal_vdomain G.arr_Rel_ArrVal_vrange 
            have b': "b' ∈∘ B" and b'': "b'' ∈∘ B'"
              by auto
            from aa'' H.arr_Rel_ArrVal_vdomain H.arr_Rel_ArrVal_vrange 
            have a': "a' ∈∘ A" and a'': "a'' ∈∘ A'"
              by auto
            from abc_abc' have "abc ∈∘ π’Ÿβˆ˜ (?ABC⦇ArrVal⦈)" by auto
            then have "abc ∈∘ (A Γ—βˆ˜ B) Γ—βˆ˜ C" by (simp add: cat_cs_simps)
            then obtain a b c
              where abc_def: "abc = ⟨⟨a, b⟩, c⟩"
                and a: "a ∈∘ A"
                and b: "b ∈∘ B"
                and c: "c ∈∘ C"
              by auto
            from abc_abc' have "abc' = ?ABC⦇ArrValβ¦ˆβ¦‡abc⦈"
              by (simp add: vsv.vsv_appI[OF MΞ±_Rel_arrow_lr_ArrVal_vsv])
            also from a b c have "… = ⟨a, ⟨b, c⟩⟩"
              unfolding abc_def bc'_def
              by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
            finally have abc'_def': "abc' = ⟨a, ⟨b, c⟩⟩" by auto
            with abc'_def[unfolded bc'_def] have [cat_cs_simps]:
              "a = a'" "b = b'" "c = c'"
              by auto
            from a'' b'' c'' have "⟨⟨a'', b''⟩, c''⟩ ∈∘ (A' Γ—βˆ˜ B') Γ—βˆ˜ C'"
              by (cs_concl cs_intro: V_cs_intros)
            with aa'' bb'' cc'' a a' b b' c c' show 
              "abc_abc'' ∈∘ ?ABC'⦇ArrVal⦈ ∘∘ ?HG_F"
              unfolding abc_abc''_def abc_def abc'_def abc''_def bc''_def
              by (intro vcompI prod_2_Rel_ArrValI)
               (
                 cs_concl 
                  cs_simp: cat_cs_simps 
                  cs_intro: 
                    vsv.vsv_ex1_app2[THEN iffD1] 
                    V_cs_intros cat_cs_intros cat_Rel_cs_intros
               )+
          qed

          from that H_is_arr G_is_arr F_is_arr show 
            "(?ABC' ∘Acat_Rel Ξ± prod_2_Rel (prod_2_Rel H G) F)⦇ArrVal⦈ =
              (prod_2_Rel H (prod_2_Rel G F) ∘Acat_Rel Ξ± ?ABC)⦇ArrVal⦈"
            by
              (
                cs_concl
                  cs_simp:
                    prod_2_Rel_components comp_Rel_components
                    cat_Rel_cs_simps cat_cs_simps 
                  cs_intro: 
                    cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
              )

        qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

      qed

      from that H_is_arr G_is_arr F_is_arr show ?thesis
        unfolding HGF_def ABC_def ABC'_def
        by 
          (
            cs_concl 
              cs_intro: 
                cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros 
              cs_simp: cat_Rel_cs_simps cat_cs_simps
          )

    qed

  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

qed

lemma (in 𝒡) MΞ±_Rel_is_iso_ntcf'[cat_cs_intros]: 
  assumes "𝔉' = cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))"
    and "π”Š' = cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))"
    and "𝔄' = cat_Rel Ξ±^C3"
    and "𝔅' = cat_Rel Ξ±"
    and "Ξ±' = Ξ±"
  shows "MΞ±_Rel (cat_Rel Ξ±) : 𝔉' ↦CF.iso π”Š' : 𝔄' ↦↦CΞ±' 𝔅'"
  unfolding assms by (rule MΞ±_Rel_is_iso_ntcf)

lemmas [cat_cs_intros] = 𝒡.MΞ±_Rel_is_iso_ntcf'



subsectionβ€Ήβ€ΉMlβ€Ί and β€ΉMrβ€Ί for β€ΉRelβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition Ml_Rel :: "V β‡’ V β‡’ V"
  where "Ml_Rel β„­ a =
    [
      (Ξ»Bβˆˆβˆ˜β„­β¦‡Obj⦈. vsnd_arrow (set {a}) B),
      cf_prod_2_Rel β„­β„­,β„­(set {a},-)CF,
      cf_id β„­,
      β„­,
      β„­
    ]∘"

definition Mr_Rel :: "V β‡’ V β‡’ V"
  where "Mr_Rel β„­ b =
    [
      (Ξ»Aβˆˆβˆ˜β„­β¦‡Obj⦈. vfst_arrow A (set {b})),
      cf_prod_2_Rel β„­β„­,β„­(-,set {b})CF,
      cf_id β„­,
      β„­,
      β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma Ml_Rel_components:
  shows "Ml_Rel β„­ a⦇NTMap⦈ = (Ξ»Bβˆˆβˆ˜β„­β¦‡Obj⦈. vsnd_arrow (set {a}) B)"
    and [cat_cs_simps]: "Ml_Rel β„­ a⦇NTDom⦈ = cf_prod_2_Rel β„­β„­,β„­(set {a},-)CF"
    and [cat_cs_simps]: "Ml_Rel β„­ a⦇NTCod⦈ = cf_id β„­"
    and [cat_cs_simps]: "Ml_Rel β„­ a⦇NTDGDom⦈ = β„­"
    and [cat_cs_simps]: "Ml_Rel β„­ a⦇NTDGCod⦈ = β„­"
  unfolding Ml_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)

lemma Mr_Rel_components:
  shows "Mr_Rel β„­ b⦇NTMap⦈ = (Ξ»Aβˆˆβˆ˜β„­β¦‡Obj⦈. vfst_arrow A (set {b}))"
    and [cat_cs_simps]: "Mr_Rel β„­ b⦇NTDom⦈ = cf_prod_2_Rel β„­β„­,β„­(-,set {b})CF"
    and [cat_cs_simps]: "Mr_Rel β„­ b⦇NTCod⦈ = cf_id β„­"
    and [cat_cs_simps]: "Mr_Rel β„­ b⦇NTDGDom⦈ = β„­"
    and [cat_cs_simps]: "Mr_Rel β„­ b⦇NTDGCod⦈ = β„­"
  unfolding Mr_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda Ml_Rel_components(1)
  |vsv Ml_Rel_components_NTMap_vsv[cat_cs_intros]|
  |vdomain Ml_Rel_components_NTMap_vdomain[cat_cs_simps]|
  |app Ml_Rel_components_NTMap_app[cat_cs_simps]|

mk_VLambda Mr_Rel_components(1)
  |vsv Mr_Rel_components_NTMap_vsv[cat_cs_intros]|
  |vdomain Mr_Rel_components_NTMap_vdomain[cat_cs_simps]|
  |app Mr_Rel_components_NTMap_app[cat_cs_simps]|


subsubsectionβ€Ήβ€ΉMlβ€Ί and β€ΉMrβ€Ί for β€ΉRelβ€Ί are natural isomorphismsβ€Ί

lemma (in 𝒡) Ml_Rel_is_iso_ntcf:
  assumes "a ∈∘ cat_Rel α⦇Obj⦈"
  shows "Ml_Rel (cat_Rel Ξ±) a:
    cf_prod_2_Rel (cat_Rel Ξ±)cat_Rel Ξ±,cat_Rel Ξ±(set {a},-)CF ↦CF.iso 
    cf_id (cat_Rel Ξ±) : 
    cat_Rel Ξ± ↦↦CΞ± cat_Rel Ξ±"
proof-

  let ?cf_prod = β€Ήcf_prod_2_Rel (cat_Rel Ξ±)cat_Rel Ξ±,cat_Rel Ξ± (set {a},-)CFβ€Ί
  note [cat_cs_simps] = set_empty

  interpret cf_prod: is_functor 
    Ξ± β€Ήcat_Rel Ξ± Γ—C cat_Rel Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί β€Ήcf_prod_2_Rel (cat_Rel Ξ±)β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
  
  show ?thesis
  proof(intro is_iso_ntcfI is_ntcfI')
    show "vfsequence (Ml_Rel (cat_Rel Ξ±) a)" unfolding Ml_Rel_def by auto
    show "vcard (Ml_Rel (cat_Rel Ξ±) a) = 5β„•"
      unfolding Ml_Rel_def by (simp add: nat_omega_simps)
    from assms show "?cf_prod : cat_Rel Ξ± ↦↦CΞ± cat_Rel Ξ±"
      by
        (
          cs_concl
            cs_simp: cat_Rel_components(1) cat_cs_simps 
            cs_intro: cat_cs_intros V_cs_intros
        )
    show "Ml_Rel (cat_Rel Ξ±) a⦇NTMapβ¦ˆβ¦‡B⦈ :
      ?cf_prod⦇ObjMapβ¦ˆβ¦‡B⦈ ↦isocat_Rel Ξ± cf_id (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡B⦈"
      if "B ∈∘ cat_Rel α⦇Obj⦈" for B 
      using assms that
      by
        (
          cs_concl
            cs_simp: cat_Rel_components(1) V_cs_simps cat_cs_simps 
            cs_intro:
              cat_Rel_par_set_cs_intros
              cat_cs_intros 
              V_cs_intros
              cat_prod_cs_intros
        )
    with cat_Rel_is_arr_isomorphismD[OF this] show 
      "Ml_Rel (cat_Rel Ξ±) a⦇NTMapβ¦ˆβ¦‡B⦈ :
        ?cf_prod⦇ObjMapβ¦ˆβ¦‡B⦈ ↦cat_Rel Ξ± cf_id (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡B⦈"
      if "B ∈∘ cat_Rel α⦇Obj⦈" for B
      using that by simp
    show
      "Ml_Rel (cat_Rel Ξ±) a⦇NTMapβ¦ˆβ¦‡B⦈ ∘Acat_Rel Ξ± ?cf_prod⦇ArrMapβ¦ˆβ¦‡F⦈ =
        cf_id (cat_Rel Ξ±)⦇ArrMapβ¦ˆβ¦‡F⦈ ∘Acat_Rel Ξ± Ml_Rel (cat_Rel Ξ±) a⦇NTMapβ¦ˆβ¦‡A⦈"
      if "F : A ↦cat_Rel Ξ± B" for A B F 
    proof-
      note F = cat_Rel_is_arrD[OF that]
      interpret F: arr_Rel Ξ± F
        rewrites "F⦇ArrDom⦈ = A" and "F⦇ArrCod⦈ = B"
        by (intro F)+
      have [cat_cs_simps]:
        "vsnd_arrow (set {a}) B ∘Acat_Rel α 
          prod_2_Rel (cat_Rel α⦇CIdβ¦ˆβ¦‡set {a}⦈) F =
            F ∘Acat_Rel α vsnd_arrow (set {a}) A"
        (is β€Ή?B2 ∘Acat_Rel Ξ± ?aF = F ∘Acat_Rel Ξ± ?A2β€Ί)
      proof-
        from assms that have lhs:
          "?B2 ∘Acat_Rel Ξ± ?aF : set {a} Γ—βˆ˜ A ↦cat_Rel Ξ± B"
          by
            (
              cs_concl
                cs_simp: cat_Rel_components(1) cat_cs_simps
                cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros V_cs_intros
            )
        from assms that have rhs:
          "F ∘Acat_Rel Ξ± ?A2 : set {a} Γ—βˆ˜ A ↦cat_Rel Ξ± B"
          by
            (
              cs_concl
                cs_simp: cat_Rel_components(1) cat_cs_simps
                cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros V_cs_intros
            )
        have [cat_cs_simps]: 
          "?B2⦇ArrVal⦈ ∘∘ prod_2_Rel_ArrVal (vid_on (set {a})) (F⦇ArrVal⦈) =
            F⦇ArrVal⦈ ∘∘ ?A2⦇ArrVal⦈"
        proof(intro vsubset_antisym vsubsetI)
          fix xx'_z assume "xx'_z ∈∘
            ?B2⦇ArrVal⦈ ∘∘ prod_2_Rel_ArrVal (vid_on (set {a})) (F⦇ArrVal⦈)"
          then obtain xx' yy' z
            where xx'_z_def: "xx'_z = ⟨xx', z⟩" 
              and xx'_yy':
                "⟨xx', yy'⟩ ∈∘ prod_2_Rel_ArrVal (vid_on (set {a})) (F⦇ArrVal⦈)"
              and yy'_z: "⟨yy', z⟩ ∈∘ ?B2⦇ArrVal⦈" 
            by auto
          from xx'_yy' obtain x x' y y'
            where "⟨xx', yy'⟩ = ⟨⟨x, x'⟩, ⟨y, y'⟩⟩"
              and "⟨x, y⟩ ∈∘ vid_on (set {a})"
              and xy': "⟨x', y'⟩ ∈∘ F⦇ArrVal⦈"
            by auto
          then have xx'_def: "xx' = ⟨a, x'⟩" and yy'_def: "yy' = ⟨a, y'⟩"
            by simp_all
          with yy'_z have y': "y' ∈∘ B" and z_def: "z = y'"
            unfolding vsnd_arrow_components by auto
          from xy' vsubsetD have x': "x' ∈∘ A"
            by (auto intro: F.arr_Rel_ArrVal_vdomain)
          show "xx'_z ∈∘ F⦇ArrVal⦈ ∘∘ ?A2⦇ArrVal⦈"
            unfolding xx'_z_def z_def xx'_def
            by (intro vcompI, rule xy') 
              (auto simp: vsnd_arrow_components x' VLambda_iff2)
        next
          fix ay_z assume "ay_z ∈∘ F⦇ArrVal⦈ ∘∘ ?A2⦇ArrVal⦈"
          then obtain ay y z
            where xx'_z_def: "ay_z = ⟨ay, z⟩" 
              and ay_y: "⟨ay, y⟩ ∈∘ ?A2⦇ArrVal⦈"
              and yz[cat_cs_intros]: "⟨y, z⟩ ∈∘ F⦇ArrVal⦈" 
            by auto
          then have ay_z_def: "ay_z = ⟨⟨a, y⟩, z⟩"
            and y: "y ∈∘ A"
            and ay_def: "ay = ⟨a, y⟩"
            unfolding vsnd_arrow_components by auto
          from yz vsubsetD have z: "z ∈∘ B"
            by (auto intro: F.arr_Rel_ArrVal_vrange)
          have [cat_cs_intros]: "⟨a, a⟩ ∈∘ vid_on (set {a})" by auto 
          show "ay_z ∈∘
            ?B2⦇ArrVal⦈ ∘∘ prod_2_Rel_ArrVal (vid_on (set {a})) (F⦇ArrVal⦈)"
            unfolding ay_z_def
            by
              (
                intro vcompI prod_2_Rel_ArrValI, 
                rule vsv.vsv_ex1_app1[THEN iffD1], 
                unfold cat_cs_simps, 
                insert z
              )
              (
                cs_concl 
                  cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
              )
        qed
        show ?thesis
        proof(rule arr_Rel_eqI)
          from lhs show arr_Rel_lhs: "arr_Rel α (?B2 ∘Acat_Rel α ?aF)"
            by (auto dest: cat_Rel_is_arrD)
          from rhs show "arr_Rel α (F ∘Acat_Rel α ?A2)"
            by (auto dest: cat_Rel_is_arrD)
          note cat_Rel_CId_app[cat_Rel_cs_simps del]
          note 𝒡.cat_Rel_CId_app[cat_Rel_cs_simps del]
          from that assms show
            "(?B2 ∘Acat_Rel Ξ± ?aF)⦇ArrVal⦈ = (F ∘Acat_Rel Ξ± ?A2)⦇ArrVal⦈"
            by (*slow*)
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_Rel_cs_simps
                  cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
                  cs_simp: 
                    id_Rel_components 
                    cat_Rel_CId_app 
                    comp_Rel_components(1) 
                    prod_2_Rel_components 
                    cat_Rel_components(1)
              )
        qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
      qed
      from that assms show ?thesis
        by
          (
            cs_concl
              cs_simp: cat_cs_simps
              cs_intro: cat_cs_intros V_cs_intros cat_prod_cs_intros
              cs_simp: cat_Rel_components(1) V_cs_simps
          )
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

qed

lemma (in 𝒡) Ml_Rel_is_iso_ntcf'[cat_cs_intros]:
  assumes "a ∈∘ cat_Rel α⦇Obj⦈"
    and "𝔉' = cf_prod_2_Rel (cat_Rel Ξ±)cat_Rel Ξ±,cat_Rel Ξ±(set {a},-)CF"
    and "π”Š' = cf_id (cat_Rel Ξ±)"
    and "𝔄' = cat_Rel Ξ±"
    and "𝔅' = cat_Rel Ξ±"
    and "Ξ±' = Ξ±"
  shows "Ml_Rel (cat_Rel Ξ±) a : 𝔉' ↦CF.iso π”Š' : 𝔄' ↦↦CΞ± 𝔅'"
  using assms(1) unfolding assms(2-6) by (rule Ml_Rel_is_iso_ntcf)

lemmas [cat_cs_intros] = 𝒡.Ml_Rel_is_iso_ntcf'

lemma (in 𝒡) Mr_Rel_is_iso_ntcf:
  assumes "b ∈∘ cat_Rel α⦇Obj⦈"
  shows "Mr_Rel (cat_Rel Ξ±) b :
    cf_prod_2_Rel (cat_Rel Ξ±)cat_Rel Ξ±,cat_Rel Ξ±(-,set {b})CF ↦CF.iso 
    cf_id (cat_Rel Ξ±) : 
    cat_Rel Ξ± ↦↦CΞ± cat_Rel Ξ±"
proof-

  let ?cf_prod = β€Ήcf_prod_2_Rel (cat_Rel Ξ±)cat_Rel Ξ±,cat_Rel Ξ± (-,set {b})CFβ€Ί
  note [cat_cs_simps] = set_empty

  interpret cf_prod: is_functor 
    Ξ± β€Ήcat_Rel Ξ± Γ—C cat_Rel Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί β€Ήcf_prod_2_Rel (cat_Rel Ξ±)β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
  
  show ?thesis
  proof(intro is_iso_ntcfI is_ntcfI')
    show "vfsequence (Mr_Rel (cat_Rel Ξ±) b)" unfolding Mr_Rel_def by auto
    show "vcard (Mr_Rel (cat_Rel Ξ±) b) = 5β„•"
      unfolding Mr_Rel_def by (simp add: nat_omega_simps)
    from assms show "?cf_prod : cat_Rel Ξ± ↦↦CΞ± cat_Rel Ξ±"
      by
        (
          cs_concl
            cs_simp: cat_Rel_components(1) cat_cs_simps 
            cs_intro: cat_cs_intros V_cs_intros
        )
    show "Mr_Rel (cat_Rel Ξ±) b⦇NTMapβ¦ˆβ¦‡B⦈ :
      ?cf_prod⦇ObjMapβ¦ˆβ¦‡B⦈ ↦isocat_Rel Ξ± cf_id (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡B⦈"
      if "B ∈∘ cat_Rel α⦇Obj⦈" for B 
      using assms that
      by
        (
          cs_concl
            cs_simp: cat_Rel_components(1) V_cs_simps cat_cs_simps
            cs_intro:
              cat_cs_intros
              cat_Rel_par_set_cs_intros
              V_cs_intros
              cat_prod_cs_intros
        )
    with cat_Rel_is_arr_isomorphismD[OF this] show 
      "Mr_Rel (cat_Rel Ξ±) b⦇NTMapβ¦ˆβ¦‡B⦈ :
        ?cf_prod⦇ObjMapβ¦ˆβ¦‡B⦈ ↦cat_Rel Ξ± cf_id (cat_Rel Ξ±)⦇ObjMapβ¦ˆβ¦‡B⦈"
      if "B ∈∘ cat_Rel α⦇Obj⦈" for B
      using that by simp
    show
      "Mr_Rel (cat_Rel Ξ±) b⦇NTMapβ¦ˆβ¦‡B⦈ ∘Acat_Rel Ξ± ?cf_prod⦇ArrMapβ¦ˆβ¦‡F⦈ =
        cf_id (cat_Rel Ξ±)⦇ArrMapβ¦ˆβ¦‡F⦈ ∘Acat_Rel Ξ± Mr_Rel (cat_Rel Ξ±) b⦇NTMapβ¦ˆβ¦‡A⦈"
      if "F : A ↦cat_Rel Ξ± B" for A B F 
    proof-
      note F = cat_Rel_is_arrD[OF that]
      interpret F: arr_Rel Ξ± F
        rewrites "F⦇ArrDom⦈ = A" and "F⦇ArrCod⦈ = B"
        by (intro F)+
      have [cat_cs_simps]:
        "vfst_arrow B (set {b}) ∘Acat_Rel α
          prod_2_Rel F (cat_Rel α⦇CIdβ¦ˆβ¦‡set {b}⦈) =
            F ∘Acat_Rel α vfst_arrow A (set {b})"
        (is β€Ή?B1 ∘Acat_Rel Ξ± ?bF = F ∘Acat_Rel Ξ± ?A1β€Ί)
      proof-
        from assms that have lhs:
          "?B1 ∘Acat_Rel Ξ± ?bF : A Γ—βˆ˜ set {b} ↦cat_Rel Ξ± B"
          by
            (
              cs_concl
                cs_simp: cat_Rel_components(1) cat_cs_simps
                cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
            )
        from assms that have rhs:
          "F ∘Acat_Rel Ξ± ?A1 : A Γ—βˆ˜ set {b} ↦cat_Rel Ξ± B"
          by
            (
              cs_concl
                cs_simp: cat_Rel_components(1) cat_cs_simps
                cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
            )
        have [cat_cs_simps]: 
          "?B1⦇ArrVal⦈ ∘∘ prod_2_Rel_ArrVal (F⦇ArrVal⦈) (vid_on (set {b})) =
            F⦇ArrVal⦈ ∘∘ ?A1⦇ArrVal⦈"
        proof(intro vsubset_antisym vsubsetI)
          fix xx'_z assume "xx'_z ∈∘
            ?B1⦇ArrVal⦈ ∘∘ prod_2_Rel_ArrVal (F⦇ArrVal⦈) (vid_on (set {b}))"
          then obtain xx' yy' z
            where xx'_z_def: "xx'_z = ⟨xx', z⟩" 
              and xx'_yy':
                "⟨xx', yy'⟩ ∈∘ prod_2_Rel_ArrVal (F⦇ArrVal⦈) (vid_on (set {b}))"
              and yy'_z: "⟨yy', z⟩ ∈∘ ?B1⦇ArrVal⦈" 
            by auto
          from xx'_yy' obtain x x' y y'
            where "⟨xx', yy'⟩ = ⟨⟨x, x'⟩, ⟨y, y'⟩⟩"
              and "⟨x', y'⟩ ∈∘ vid_on (set {b})"
              and xy: "⟨x, y⟩ ∈∘ F⦇ArrVal⦈"
            by auto
          then have xx'_def: "xx' = ⟨x, b⟩" and yy'_def: "yy' = ⟨y, b⟩"
            by simp_all
          with yy'_z have y': "y ∈∘ B" and z_def: "z = y"
            unfolding vfst_arrow_components by auto
          from xy vsubsetD have x: "x ∈∘ A"
            by (auto intro: F.arr_Rel_ArrVal_vdomain)
          show "xx'_z ∈∘ F⦇ArrVal⦈ ∘∘ ?A1⦇ArrVal⦈"
            unfolding xx'_z_def z_def xx'_def
            by (intro vcompI, rule xy) 
              (auto simp: vfst_arrow_components x VLambda_iff2)
        next
          fix xy_z assume "xy_z ∈∘ F⦇ArrVal⦈ ∘∘ ?A1⦇ArrVal⦈"
          then obtain xy y z
            where xx'_z_def: "xy_z = ⟨xy, z⟩" 
              and xy_y: "⟨xy, y⟩ ∈∘ ?A1⦇ArrVal⦈"
              and yz[cat_cs_intros]: "⟨y, z⟩ ∈∘ F⦇ArrVal⦈" 
            by auto
          then have xy_z_def: "xy_z = ⟨⟨y, b⟩, z⟩"
            and y: "y ∈∘ A"
            and xy_def: "xy = ⟨y, b⟩"
            unfolding vfst_arrow_components by auto
          from yz vsubsetD have z: "z ∈∘ B"
            by (auto intro: F.arr_Rel_ArrVal_vrange)
          have [cat_cs_intros]: "⟨b, b⟩ ∈∘ vid_on (set {b})" by auto 
          show "xy_z ∈∘
            ?B1⦇ArrVal⦈ ∘∘ prod_2_Rel_ArrVal (F⦇ArrVal⦈) (vid_on (set {b}))"
            unfolding xy_z_def
            by
              (
                intro vcompI prod_2_Rel_ArrValI, 
                rule vsv.vsv_ex1_app1[THEN iffD1], 
                unfold cat_cs_simps, 
                insert z
              )
              (
                cs_concl
                  cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
              )
        qed
        show ?thesis
        proof(rule arr_Rel_eqI)
          from lhs show arr_Rel_lhs: "arr_Rel α (?B1 ∘Acat_Rel α ?bF)"
            by (auto dest: cat_Rel_is_arrD)
          from rhs show "arr_Rel α (F ∘Acat_Rel α ?A1)"
            by (auto dest: cat_Rel_is_arrD)
          note cat_Rel_CId_app[cat_Rel_cs_simps del]
          note 𝒡.cat_Rel_CId_app[cat_Rel_cs_simps del]
          from that assms show
            "(?B1 ∘Acat_Rel Ξ± ?bF)⦇ArrVal⦈ = (F ∘Acat_Rel Ξ± ?A1)⦇ArrVal⦈"
            by (*slow*)
              (
                cs_concl 
                  cs_simp: cat_cs_simps cat_Rel_cs_simps 
                  cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros 
                  cs_simp:
                    id_Rel_components
                    cat_Rel_CId_app
                    comp_Rel_components(1) 
                    prod_2_Rel_components
                    cat_Rel_components(1)
              )
        qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
      qed
      from that assms show ?thesis
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros V_cs_intros cat_prod_cs_intros
              cs_simp: cat_Rel_components(1) V_cs_simps
          )
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

qed

lemma (in 𝒡) Mr_Rel_is_iso_ntcf'[cat_cs_intros]:
  assumes "b ∈∘ cat_Rel α⦇Obj⦈"
    and "𝔉' = cf_prod_2_Rel (cat_Rel Ξ±)cat_Rel Ξ±,cat_Rel Ξ±(-,set {b})CF"
    and "π”Š' = cf_id (cat_Rel Ξ±)"
    and "𝔄' = cat_Rel Ξ±"
    and "𝔅' = cat_Rel Ξ±"
    and "Ξ±' = Ξ±"
  shows "Mr_Rel (cat_Rel Ξ±) b : 𝔉' ↦CF.iso π”Š' : 𝔄' ↦↦CΞ± 𝔅'"
  using assms(1) unfolding assms(2-6) by (rule Mr_Rel_is_iso_ntcf)

lemmas [cat_cs_intros] = 𝒡.Mr_Rel_is_iso_ntcf'



subsectionβ€Ήβ€ΉRelβ€Ί as a monoidal categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
For further information see
\cite{noauthor_wikipedia_2001}\footnote{\url{
https://en.wikipedia.org/wiki/Category_of_relations
}}.
β€Ί

definition mcat_Rel :: "V β‡’ V β‡’ V"
  where "mcat_Rel Ξ± a =
    [
      cat_Rel Ξ±,
      cf_prod_2_Rel (cat_Rel Ξ±),
      set {a},
      MΞ±_Rel (cat_Rel Ξ±),
      Ml_Rel (cat_Rel Ξ±) a,
      Mr_Rel (cat_Rel Ξ±) a
    ]∘"


textβ€ΉComponents.β€Ί

lemma mcat_Rel_components:
  shows "mcat_Rel Ξ± a⦇Mcat⦈ = cat_Rel Ξ±"
    and "mcat_Rel Ξ± a⦇Mcf⦈ = cf_prod_2_Rel (cat_Rel Ξ±)"
    and "mcat_Rel Ξ± a⦇Me⦈ = set {a}"
    and "mcat_Rel Ξ± a⦇Mα⦈ = MΞ±_Rel (cat_Rel Ξ±)"
    and "mcat_Rel Ξ± a⦇Ml⦈ = Ml_Rel (cat_Rel Ξ±) a"
    and "mcat_Rel Ξ± a⦇Mr⦈ = Mr_Rel (cat_Rel Ξ±) a"
  unfolding mcat_Rel_def mcat_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€Ήβ€ΉRelβ€Ί is a monoidal categoryβ€Ί

lemma (in 𝒡) 
  assumes "a ∈∘ cat_Rel α⦇Obj⦈"
  shows "monoidal_category Ξ± (mcat_Rel Ξ± a)"
proof-

  interpret Set_Par: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Par Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Set_cat_Par)
  interpret Par_Rel: wide_replete_subcategory Ξ± β€Ήcat_Par Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by (rule wide_replete_subcategory_cat_Par_cat_Rel)
  interpret Set_Rel: wide_replete_subcategory Ξ± β€Ήcat_Set Ξ±β€Ί β€Ήcat_Rel Ξ±β€Ί 
    by 
      ( 
        rule wr_subcat_trans
          [
            OF 
              Set_Par.wide_replete_subcategory_axioms 
              Par_Rel.wide_replete_subcategory_axioms
          ]
      )

  show ?thesis
  proof(rule monoidal_categoryI)
    show "vfsequence (mcat_Rel Ξ± a)" unfolding mcat_Rel_def by auto
    show "category Ξ± (mcat_Rel Ξ± a⦇Mcat⦈)"
      unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
    show "mcat_Rel Ξ± a⦇Mcf⦈ :
      mcat_Rel Ξ± a⦇Mcat⦈ Γ—C mcat_Rel Ξ± a⦇Mcat⦈ ↦↦CΞ± mcat_Rel Ξ± a⦇Mcat⦈"
      unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
    show "mcat_Rel Ξ± a⦇Mα⦈ :
      cf_blcomp (mcat_Rel Ξ± a⦇Mcf⦈) ↦CF.iso cf_brcomp (mcat_Rel Ξ± a⦇Mcf⦈) : 
      mcat_Rel Ξ± a⦇Mcat⦈^C3 ↦↦CΞ± mcat_Rel Ξ± a⦇Mcat⦈"
      unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
    from assms show "mcat_Rel Ξ± a⦇Ml⦈ :
      mcat_Rel Ξ± a⦇Mcf⦈mcat_Rel Ξ± a⦇Mcat⦈,mcat_Rel Ξ± a⦇Mcat⦈ (mcat_Rel Ξ± a⦇Me⦈,-)CF
        ↦CF.iso 
      cf_id (mcat_Rel Ξ± a⦇Mcat⦈) :
      mcat_Rel Ξ± a⦇Mcat⦈ ↦↦CΞ± mcat_Rel Ξ± a⦇Mcat⦈"
      unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
    from assms show "mcat_Rel Ξ± a⦇Mr⦈ :
      mcat_Rel Ξ± a⦇Mcf⦈mcat_Rel Ξ± a⦇Mcat⦈,mcat_Rel Ξ± a⦇Mcat⦈ (-,mcat_Rel Ξ± a⦇Me⦈)CF
        ↦CF.iso 
      cf_id (mcat_Rel Ξ± a⦇Mcat⦈) : mcat_Rel Ξ± a⦇Mcat⦈ ↦↦CΞ± mcat_Rel Ξ± a⦇Mcat⦈"
      unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
    show "vcard (mcat_Rel Ξ± a) = 6β„•"
      unfolding mcat_Rel_def by (simp add: nat_omega_simps)
    from assms show "mcat_Rel Ξ± a⦇Me⦈ ∈∘ mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡Obj⦈"
      unfolding mcat_Rel_components cat_Rel_components by force
    show
      "mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡A⦈ βŠ—HM.Amcat_Rel Ξ± a⦇Mcf⦈ 
        mcat_Rel Ξ± a⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡B, C, Dβ¦ˆβˆ™ ∘Amcat_Rel Ξ± a⦇Mcat⦈ 
          mcat_Rel Ξ± a⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡
            A, B βŠ—HM.Omcat_Rel Ξ± a⦇Mcf⦈ C, D
            β¦ˆβˆ™ ∘Amcat_Rel Ξ± a⦇Mcat⦈ 
              (mcat_Rel Ξ± a⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡A, B, Cβ¦ˆβˆ™ βŠ—HM.Amcat_Rel Ξ± a⦇Mcf⦈ 
                mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡D⦈) = 
                  mcat_Rel Ξ± a⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡
                    A, B, C βŠ—HM.Omcat_Rel Ξ± a⦇Mcf⦈ D
                    β¦ˆβˆ™ ∘Amcat_Rel Ξ± a⦇Mcat⦈ 
                      mcat_Rel Ξ± a⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡A βŠ—HM.Omcat_Rel Ξ± a⦇Mcf⦈ B, C, Dβ¦ˆβˆ™"
      if "A ∈∘ mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡Obj⦈"
        and "B ∈∘ mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡Obj⦈"
        and "C ∈∘ mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡Obj⦈"
        and "D ∈∘ mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡Obj⦈"
      for A B C D
    proof-

      have [cat_cs_simps]:
        "prod_2_Rel (cat_Rel α⦇CIdβ¦ˆβ¦‡A⦈) (MΞ±_Rel_arrow_lr B C D) ∘Acat_Rel Ξ±
          (
            MΞ±_Rel_arrow_lr A (B Γ—βˆ˜ C) D ∘Acat_Rel Ξ±
            prod_2_Rel (MΞ±_Rel_arrow_lr A B C) (cat_Rel α⦇CIdβ¦ˆβ¦‡D⦈)
          ) =
            MΞ±_Rel_arrow_lr A B (C Γ—βˆ˜ D) ∘Acat_Rel Ξ±
              MΞ±_Rel_arrow_lr (A Γ—βˆ˜ B) C D"
        (
          is 
            β€Ή
              ?A_BCD ∘Acat_Rel α (?A_BC_D ∘Acat_Rel α ?ABC_D) = 
              ?A_B_CD ∘Acat_Rel α ?AB_C_D
            β€Ί
        )
      proof-

        have [cat_cs_simps]:
          "prod_2_Rel (cat_Set α⦇CIdβ¦ˆβ¦‡A⦈) (MΞ±_Rel_arrow_lr B C D) ∘Acat_Set Ξ±
            (
              ?A_BC_D ∘Acat_Set α 
              prod_2_Rel (MΞ±_Rel_arrow_lr A B C) (cat_Set α⦇CIdβ¦ˆβ¦‡D⦈)
            ) = ?A_B_CD ∘Acat_Set α ?AB_C_D"
          (
            is 
              β€Ή
                ?A_BCD ∘Acat_Set α (?A_BC_D ∘Acat_Set α ?ABC_D) = 
                ?A_B_CD ∘Acat_Set α ?AB_C_D
              β€Ί
          )
        proof-
          from that have lhs: 
            "?A_BCD ∘Acat_Set α (?A_BC_D ∘Acat_Set α ?ABC_D) :
              ((A Γ—βˆ˜ B) Γ—βˆ˜ C) Γ—βˆ˜ D ↦cat_Set Ξ± A Γ—βˆ˜ B Γ—βˆ˜ C Γ—βˆ˜ D"
            unfolding mcat_Rel_components cat_Rel_components(1)
            by
              (
                cs_concl
                  cs_simp: cat_Set_components(1)
                  cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros V_cs_intros
               )
          then have dom_lhs:
            "π’Ÿβˆ˜ ((?A_BCD ∘Acat_Set Ξ± (?A_BC_D ∘Acat_Set Ξ± ?ABC_D))⦇ArrVal⦈) = 
              ((A Γ—βˆ˜ B) Γ—βˆ˜ C) Γ—βˆ˜ D"
            by (cs_concl cs_simp: cat_cs_simps)
          from that have rhs: "?A_B_CD ∘Acat_Set α ?AB_C_D :
            ((A Γ—βˆ˜ B) Γ—βˆ˜ C) Γ—βˆ˜ D ↦cat_Set Ξ± A Γ—βˆ˜ B Γ—βˆ˜ C Γ—βˆ˜ D"
            unfolding mcat_Rel_components cat_Rel_components(1)
            by
              (
                cs_concl
                  cs_simp: cat_Rel_components(1) cat_Set_components(1) 
                  cs_intro: 
                    cat_cs_intros V_cs_intros MΞ±_Rel_arrow_lr_is_cat_Set_arr' 
               )
          then have dom_rhs:
            "π’Ÿβˆ˜ ((?A_B_CD ∘Acat_Set Ξ± ?AB_C_D)⦇ArrVal⦈) = 
              ((A Γ—βˆ˜ B) Γ—βˆ˜ C) Γ—βˆ˜ D"
            by (cs_concl cs_simp: cat_cs_simps)
          show ?thesis
          proof(rule arr_Set_eqI)
            from lhs show arr_Set_lhs: 
              "arr_Set α (?A_BCD ∘Acat_Set α (?A_BC_D ∘Acat_Set α ?ABC_D))"
              by (auto dest: cat_Set_is_arrD(1))
            from rhs show arr_Set_rhs:
              "arr_Set α (?A_B_CD ∘Acat_Set α ?AB_C_D)"
              by (auto dest: cat_Set_is_arrD(1))
            show 
              "(?A_BCD ∘Acat_Set Ξ± (?A_BC_D ∘Acat_Set Ξ± ?ABC_D))⦇ArrVal⦈ =
                (?A_B_CD ∘Acat_Set Ξ± ?AB_C_D)⦇ArrVal⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix abcd assume prems: "abcd ∈∘ ((A Γ—βˆ˜ B) Γ—βˆ˜ C) Γ—βˆ˜ D"
              then obtain a b c d 
                where abcd_def: "abcd = ⟨⟨⟨a, b⟩, c⟩, d⟩" 
                  and a: "a ∈∘ A" 
                  and b: "b ∈∘ B" 
                  and c: "c ∈∘ C" 
                  and d: "d ∈∘ D"
                by clarsimp
              from that prems a b c d show 
                "(
                  ?A_BCD ∘Acat_Set α
                    (?A_BC_D ∘Acat_Set α ?ABC_D)
                 )⦇ArrValβ¦ˆβ¦‡abcd⦈ =
                  (?A_B_CD ∘Acat_Set Ξ± ?AB_C_D)⦇ArrValβ¦ˆβ¦‡abcd⦈"
                unfolding abcd_def mcat_Rel_components(1) cat_Rel_components(1)
                by (*slow*)
                  (
                    cs_concl
                      cs_simp: 
                        cat_Set_components(1) 
                        cat_cs_simps 
                        cat_rel_par_Set_cs_simps
                      cs_intro: 
                        cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
                  )
            qed (use arr_Set_lhs arr_Set_rhs in auto)
          qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
        qed

        from assms that show ?thesis
          unfolding mcat_Rel_components cat_Rel_components(1)
          by
            (
              cs_concl
                cs_simp:
                  cat_cs_simps
                  cat_Rel_components(1)
                  cat_Set_components(1)
                  Set_Rel.subcat_CId[symmetric]
                  Set_Rel.subcat_Comp_simp[symmetric]
                cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
            )+

      qed

      from that show ?thesis 
        unfolding mcat_Rel_components cat_Rel_components(1)
        by
          (
            cs_concl
              cs_simp: cat_Rel_components(1) cat_cs_simps
              cs_intro: 
                cat_cs_intros 
                cat_Rel_par_set_cs_intros
                V_cs_intros 
                cat_prod_cs_intros
          )
  
    qed

    show
      "mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡A⦈ βŠ—HM.Amcat_Rel Ξ± a⦇Mcf⦈
        mcat_Rel Ξ± a⦇Mlβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡B⦈ ∘Amcat_Rel Ξ± a⦇Mcat⦈
          mcat_Rel Ξ± a⦇MΞ±β¦ˆβ¦‡NTMapβ¦ˆβ¦‡A, mcat_Rel Ξ± a⦇Me⦈, Bβ¦ˆβˆ™ =
            mcat_Rel Ξ± a⦇Mrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡A⦈ βŠ—HM.Amcat_Rel Ξ± a⦇Mcf⦈
              mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡CIdβ¦ˆβ¦‡B⦈"
      if "A ∈∘ mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡Obj⦈" and "B ∈∘ mcat_Rel Ξ± a⦇Mcatβ¦ˆβ¦‡Obj⦈" for A B 
    proof-
  
      note [cat_cs_simps] = set_empty
  
      have [cat_cs_simps]: 
        "prod_2_Rel (cat_Set α⦇CIdβ¦ˆβ¦‡A⦈) (vsnd_arrow (set {a}) B) ∘Acat_Set Ξ±
          MΞ±_Rel_arrow_lr A (set {a}) B =
            prod_2_Rel (vfst_arrow A (set {a})) (cat_Set α⦇CIdβ¦ˆβ¦‡B⦈)"
        (is β€Ή?A_aB ∘Acat_Set Ξ± ?AaB = ?Aa_Bβ€Ί)
      proof-
        from assms that have lhs: 
          "?A_aB ∘Acat_Set Ξ± ?AaB : (A Γ—βˆ˜ set {a}) Γ—βˆ˜ B ↦cat_Set Ξ± A Γ—βˆ˜ B"
          unfolding mcat_Rel_components cat_Rel_components(1)
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_Rel_components(1) cat_Set_components(1)
                cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
            )
        then have dom_lhs: 
          "π’Ÿβˆ˜ ((?A_aB ∘Acat_Set Ξ± ?AaB)⦇ArrVal⦈) = (A Γ—βˆ˜ set {a}) Γ—βˆ˜ B"
          by (cs_concl cs_simp: cat_cs_simps)
        from assms that have rhs:
          "?Aa_B : (A Γ—βˆ˜ set {a}) Γ—βˆ˜ B ↦cat_Set Ξ± A Γ—βˆ˜ B"
          unfolding mcat_Rel_components cat_Rel_components(1)
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cat_Set_components(1)
                cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
            )
        then have dom_rhs: "π’Ÿβˆ˜ (?Aa_B⦇ArrVal⦈) = (A Γ—βˆ˜ set {a}) Γ—βˆ˜ B"
          by (cs_concl cs_simp: cat_cs_simps)
        show ?thesis
        proof(rule arr_Set_eqI)
          from lhs show arr_Set_lhs: "arr_Set α (?A_aB ∘Acat_Set α ?AaB)"
            by (auto dest: cat_Set_is_arrD(1))
          from rhs show arr_Set_rhs: "arr_Set Ξ± ?Aa_B"
            by (auto dest: cat_Set_is_arrD(1))
          show "(?A_aB ∘Acat_Set Ξ± ?AaB)⦇ArrVal⦈ = ?Aa_B⦇ArrVal⦈"
          proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
            fix xay assume "xay ∈∘ (A Γ—βˆ˜ set {a}) Γ—βˆ˜ B"
            then obtain x y 
              where xay_def: "xay = ⟨⟨x, a⟩, y⟩" and x: "x ∈∘ A" and y: "y ∈∘ B"
              by auto
            from assms that x y show 
              "(?A_aB ∘Acat_Set Ξ± ?AaB)⦇ArrValβ¦ˆβ¦‡xay⦈ = ?Aa_B⦇ArrValβ¦ˆβ¦‡xay⦈"
              unfolding xay_def mcat_Rel_components cat_Rel_components(1)
              by
                (
                  cs_concl
                    cs_simp:
                      cat_Rel_components(1) cat_Set_components(1)
                      cat_cs_simps cat_rel_par_Set_cs_simps 
                    cs_intro: 
                      cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
                )
          qed (use arr_Set_lhs arr_Set_rhs in auto)
        qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
      qed
  
      from assms that show ?thesis
        unfolding mcat_Rel_components cat_Rel_components(1)
        by
          (
            cs_concl
              cs_simp: 
                cat_cs_simps 
                cat_Rel_components(1) 
                cat_Set_components(1) 
                Set_Rel.subcat_CId[symmetric] 
                Set_Rel.subcat_Comp_simp[symmetric] 
              cs_intro:
                cat_cs_intros 
                cat_rel_par_Set_cs_intros
                V_cs_intros 
                cat_prod_cs_intros 
                Set_Rel.subcat_is_arrD
          )
  
    qed
  
  qed auto

qed

textβ€Ή\newpageβ€Ί

end